1 ESTRUCTURA DE LOS DATOS

Column

Tenemos un archivo de entrenamiento para realizar un aprendizaje supervisado formado por 1460 casos con 81 variables.


Una de ellas es nuestro objetivo SalePrice, y debemos ser capaces de predecir esa variable con el dataframe Test que se nos proporciona, que es de 1459 casos.

Otra variable importante es la primera Id que nos identifica de manera única cada registro.


En el dataframe Train tenemos los 1460 primeros.

En el dataframe Test tenemos desde el 1461 hasta el 2919

Tenemos varios tipos de variables, como se vera en el siguiente epígrafe, además de las cuales cambiaremos los tipos de algunas.


Hay que realizar una limpieza y control exhaustiva de todos los datos, haciendo énfasis en los valores NA


Para realizar una preparación adecuada y buscar un modelo hay que unir los dos dataframe creando los datos que nos faltan en Test (SalePrice la variable objetivo ) y poniendo como valor NA

Column

Sumario, estructura de los dataset y dimensiones

       Id           MSSubClass      MSZoning          LotFrontage    
 Min.   :   1.0   Min.   : 20.0   Length:1460        Min.   : 21.00  
 1st Qu.: 365.8   1st Qu.: 20.0   Class :character   1st Qu.: 59.00  
 Median : 730.5   Median : 50.0   Mode  :character   Median : 69.00  
 Mean   : 730.5   Mean   : 56.9                      Mean   : 70.05  
 3rd Qu.:1095.2   3rd Qu.: 70.0                      3rd Qu.: 80.00  
 Max.   :1460.0   Max.   :190.0                      Max.   :313.00  
                                                     NA's   :259     
    LotArea          Street             Alley             LotShape        
 Min.   :  1300   Length:1460        Length:1460        Length:1460       
 1st Qu.:  7554   Class :character   Class :character   Class :character  
 Median :  9478   Mode  :character   Mode  :character   Mode  :character  
 Mean   : 10517                                                           
 3rd Qu.: 11602                                                           
 Max.   :215245                                                           
                                                                          
 LandContour         Utilities          LotConfig        
 Length:1460        Length:1460        Length:1460       
 Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character  
                                                         
                                                         
                                                         
                                                         
  LandSlope         Neighborhood        Condition1       
 Length:1460        Length:1460        Length:1460       
 Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character  
                                                         
                                                         
                                                         
                                                         
  Condition2          BldgType          HouseStyle         OverallQual    
 Length:1460        Length:1460        Length:1460        Min.   : 1.000  
 Class :character   Class :character   Class :character   1st Qu.: 5.000  
 Mode  :character   Mode  :character   Mode  :character   Median : 6.000  
                                                          Mean   : 6.099  
                                                          3rd Qu.: 7.000  
                                                          Max.   :10.000  
                                                                          
  OverallCond      YearBuilt     YearRemodAdd   RoofStyle        
 Min.   :1.000   Min.   :1872   Min.   :1950   Length:1460       
 1st Qu.:5.000   1st Qu.:1954   1st Qu.:1967   Class :character  
 Median :5.000   Median :1973   Median :1994   Mode  :character  
 Mean   :5.575   Mean   :1971   Mean   :1985                     
 3rd Qu.:6.000   3rd Qu.:2000   3rd Qu.:2004                     
 Max.   :9.000   Max.   :2010   Max.   :2010                     
                                                                 
   RoofMatl         Exterior1st        Exterior2nd       
 Length:1460        Length:1460        Length:1460       
 Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character  
                                                         
                                                         
                                                         
                                                         
  MasVnrType          MasVnrArea      ExterQual          ExterCond        
 Length:1460        Min.   :   0.0   Length:1460        Length:1460       
 Class :character   1st Qu.:   0.0   Class :character   Class :character  
 Mode  :character   Median :   0.0   Mode  :character   Mode  :character  
                    Mean   : 103.7                                        
                    3rd Qu.: 166.0                                        
                    Max.   :1600.0                                        
                    NA's   :8                                             
  Foundation          BsmtQual           BsmtCond        
 Length:1460        Length:1460        Length:1460       
 Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character  
                                                         
                                                         
                                                         
                                                         
 BsmtExposure       BsmtFinType1         BsmtFinSF1     BsmtFinType2      
 Length:1460        Length:1460        Min.   :   0.0   Length:1460       
 Class :character   Class :character   1st Qu.:   0.0   Class :character  
 Mode  :character   Mode  :character   Median : 383.5   Mode  :character  
                                       Mean   : 443.6                     
                                       3rd Qu.: 712.2                     
                                       Max.   :5644.0                     
                                                                          
   BsmtFinSF2        BsmtUnfSF       TotalBsmtSF       Heating         
 Min.   :   0.00   Min.   :   0.0   Min.   :   0.0   Length:1460       
 1st Qu.:   0.00   1st Qu.: 223.0   1st Qu.: 795.8   Class :character  
 Median :   0.00   Median : 477.5   Median : 991.5   Mode  :character  
 Mean   :  46.55   Mean   : 567.2   Mean   :1057.4                     
 3rd Qu.:   0.00   3rd Qu.: 808.0   3rd Qu.:1298.2                     
 Max.   :1474.00   Max.   :2336.0   Max.   :6110.0                     
                                                                       
  HeatingQC          CentralAir         Electrical          X1stFlrSF   
 Length:1460        Length:1460        Length:1460        Min.   : 334  
 Class :character   Class :character   Class :character   1st Qu.: 882  
 Mode  :character   Mode  :character   Mode  :character   Median :1087  
                                                          Mean   :1163  
                                                          3rd Qu.:1391  
                                                          Max.   :4692  
                                                                        
   X2ndFlrSF     LowQualFinSF       GrLivArea     BsmtFullBath   
 Min.   :   0   Min.   :  0.000   Min.   : 334   Min.   :0.0000  
 1st Qu.:   0   1st Qu.:  0.000   1st Qu.:1130   1st Qu.:0.0000  
 Median :   0   Median :  0.000   Median :1464   Median :0.0000  
 Mean   : 347   Mean   :  5.845   Mean   :1515   Mean   :0.4253  
 3rd Qu.: 728   3rd Qu.:  0.000   3rd Qu.:1777   3rd Qu.:1.0000  
 Max.   :2065   Max.   :572.000   Max.   :5642   Max.   :3.0000  
                                                                 
  BsmtHalfBath        FullBath        HalfBath       BedroomAbvGr  
 Min.   :0.00000   Min.   :0.000   Min.   :0.0000   Min.   :0.000  
 1st Qu.:0.00000   1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:2.000  
 Median :0.00000   Median :2.000   Median :0.0000   Median :3.000  
 Mean   :0.05753   Mean   :1.565   Mean   :0.3829   Mean   :2.866  
 3rd Qu.:0.00000   3rd Qu.:2.000   3rd Qu.:1.0000   3rd Qu.:3.000  
 Max.   :2.00000   Max.   :3.000   Max.   :2.0000   Max.   :8.000  
                                                                   
  KitchenAbvGr   KitchenQual         TotRmsAbvGrd     Functional       
 Min.   :0.000   Length:1460        Min.   : 2.000   Length:1460       
 1st Qu.:1.000   Class :character   1st Qu.: 5.000   Class :character  
 Median :1.000   Mode  :character   Median : 6.000   Mode  :character  
 Mean   :1.047                      Mean   : 6.518                     
 3rd Qu.:1.000                      3rd Qu.: 7.000                     
 Max.   :3.000                      Max.   :14.000                     
                                                                       
   Fireplaces    FireplaceQu         GarageType         GarageYrBlt  
 Min.   :0.000   Length:1460        Length:1460        Min.   :1900  
 1st Qu.:0.000   Class :character   Class :character   1st Qu.:1961  
 Median :1.000   Mode  :character   Mode  :character   Median :1980  
 Mean   :0.613                                         Mean   :1979  
 3rd Qu.:1.000                                         3rd Qu.:2002  
 Max.   :3.000                                         Max.   :2010  
                                                       NA's   :81    
 GarageFinish         GarageCars      GarageArea      GarageQual       
 Length:1460        Min.   :0.000   Min.   :   0.0   Length:1460       
 Class :character   1st Qu.:1.000   1st Qu.: 334.5   Class :character  
 Mode  :character   Median :2.000   Median : 480.0   Mode  :character  
                    Mean   :1.767   Mean   : 473.0                     
                    3rd Qu.:2.000   3rd Qu.: 576.0                     
                    Max.   :4.000   Max.   :1418.0                     
                                                                       
  GarageCond         PavedDrive          WoodDeckSF      OpenPorchSF    
 Length:1460        Length:1460        Min.   :  0.00   Min.   :  0.00  
 Class :character   Class :character   1st Qu.:  0.00   1st Qu.:  0.00  
 Mode  :character   Mode  :character   Median :  0.00   Median : 25.00  
                                       Mean   : 94.24   Mean   : 46.66  
                                       3rd Qu.:168.00   3rd Qu.: 68.00  
                                       Max.   :857.00   Max.   :547.00  
                                                                        
 EnclosedPorch      X3SsnPorch      ScreenPorch        PoolArea      
 Min.   :  0.00   Min.   :  0.00   Min.   :  0.00   Min.   :  0.000  
 1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.000  
 Median :  0.00   Median :  0.00   Median :  0.00   Median :  0.000  
 Mean   : 21.95   Mean   :  3.41   Mean   : 15.06   Mean   :  2.759  
 3rd Qu.:  0.00   3rd Qu.:  0.00   3rd Qu.:  0.00   3rd Qu.:  0.000  
 Max.   :552.00   Max.   :508.00   Max.   :480.00   Max.   :738.000  
                                                                     
    PoolQC             Fence           MiscFeature       
 Length:1460        Length:1460        Length:1460       
 Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character  
                                                         
                                                         
                                                         
                                                         
    MiscVal             MoSold           YrSold       SaleType        
 Min.   :    0.00   Min.   : 1.000   Min.   :2006   Length:1460       
 1st Qu.:    0.00   1st Qu.: 5.000   1st Qu.:2007   Class :character  
 Median :    0.00   Median : 6.000   Median :2008   Mode  :character  
 Mean   :   43.49   Mean   : 6.322   Mean   :2008                     
 3rd Qu.:    0.00   3rd Qu.: 8.000   3rd Qu.:2009                     
 Max.   :15500.00   Max.   :12.000   Max.   :2010                     
                                                                      
 SaleCondition        SalePrice     
 Length:1460        Min.   : 34900  
 Class :character   1st Qu.:129975  
 Mode  :character   Median :163000  
                    Mean   :180921  
                    3rd Qu.:214000  
                    Max.   :755000  
                                    
'data.frame':   1460 obs. of  81 variables:
 $ Id           : int  1 2 3 4 5 6 7 8 9 10 ...
 $ MSSubClass   : int  60 20 60 70 60 50 20 60 50 190 ...
 $ MSZoning     : chr  "RL" "RL" "RL" "RL" ...
 $ LotFrontage  : int  65 80 68 60 84 85 75 NA 51 50 ...
 $ LotArea      : int  8450 9600 11250 9550 14260 14115 10084 10382 6120 7420 ...
 $ Street       : chr  "Pave" "Pave" "Pave" "Pave" ...
 $ Alley        : chr  NA NA NA NA ...
 $ LotShape     : chr  "Reg" "Reg" "IR1" "IR1" ...
 $ LandContour  : chr  "Lvl" "Lvl" "Lvl" "Lvl" ...
 $ Utilities    : chr  "AllPub" "AllPub" "AllPub" "AllPub" ...
 $ LotConfig    : chr  "Inside" "FR2" "Inside" "Corner" ...
 $ LandSlope    : chr  "Gtl" "Gtl" "Gtl" "Gtl" ...
 $ Neighborhood : chr  "CollgCr" "Veenker" "CollgCr" "Crawfor" ...
 $ Condition1   : chr  "Norm" "Feedr" "Norm" "Norm" ...
 $ Condition2   : chr  "Norm" "Norm" "Norm" "Norm" ...
 $ BldgType     : chr  "1Fam" "1Fam" "1Fam" "1Fam" ...
 $ HouseStyle   : chr  "2Story" "1Story" "2Story" "2Story" ...
 $ OverallQual  : int  7 6 7 7 8 5 8 7 7 5 ...
 $ OverallCond  : int  5 8 5 5 5 5 5 6 5 6 ...
 $ YearBuilt    : int  2003 1976 2001 1915 2000 1993 2004 1973 1931 1939 ...
 $ YearRemodAdd : int  2003 1976 2002 1970 2000 1995 2005 1973 1950 1950 ...
 $ RoofStyle    : chr  "Gable" "Gable" "Gable" "Gable" ...
 $ RoofMatl     : chr  "CompShg" "CompShg" "CompShg" "CompShg" ...
 $ Exterior1st  : chr  "VinylSd" "MetalSd" "VinylSd" "Wd Sdng" ...
 $ Exterior2nd  : chr  "VinylSd" "MetalSd" "VinylSd" "Wd Shng" ...
 $ MasVnrType   : chr  "BrkFace" "None" "BrkFace" "None" ...
 $ MasVnrArea   : int  196 0 162 0 350 0 186 240 0 0 ...
 $ ExterQual    : chr  "Gd" "TA" "Gd" "TA" ...
 $ ExterCond    : chr  "TA" "TA" "TA" "TA" ...
 $ Foundation   : chr  "PConc" "CBlock" "PConc" "BrkTil" ...
 $ BsmtQual     : chr  "Gd" "Gd" "Gd" "TA" ...
 $ BsmtCond     : chr  "TA" "TA" "TA" "Gd" ...
 $ BsmtExposure : chr  "No" "Gd" "Mn" "No" ...
 $ BsmtFinType1 : chr  "GLQ" "ALQ" "GLQ" "ALQ" ...
 $ BsmtFinSF1   : int  706 978 486 216 655 732 1369 859 0 851 ...
 $ BsmtFinType2 : chr  "Unf" "Unf" "Unf" "Unf" ...
 $ BsmtFinSF2   : int  0 0 0 0 0 0 0 32 0 0 ...
 $ BsmtUnfSF    : int  150 284 434 540 490 64 317 216 952 140 ...
 $ TotalBsmtSF  : int  856 1262 920 756 1145 796 1686 1107 952 991 ...
 $ Heating      : chr  "GasA" "GasA" "GasA" "GasA" ...
 $ HeatingQC    : chr  "Ex" "Ex" "Ex" "Gd" ...
 $ CentralAir   : chr  "Y" "Y" "Y" "Y" ...
 $ Electrical   : chr  "SBrkr" "SBrkr" "SBrkr" "SBrkr" ...
 $ X1stFlrSF    : int  856 1262 920 961 1145 796 1694 1107 1022 1077 ...
 $ X2ndFlrSF    : int  854 0 866 756 1053 566 0 983 752 0 ...
 $ LowQualFinSF : int  0 0 0 0 0 0 0 0 0 0 ...
 $ GrLivArea    : int  1710 1262 1786 1717 2198 1362 1694 2090 1774 1077 ...
 $ BsmtFullBath : int  1 0 1 1 1 1 1 1 0 1 ...
 $ BsmtHalfBath : int  0 1 0 0 0 0 0 0 0 0 ...
 $ FullBath     : int  2 2 2 1 2 1 2 2 2 1 ...
 $ HalfBath     : int  1 0 1 0 1 1 0 1 0 0 ...
 $ BedroomAbvGr : int  3 3 3 3 4 1 3 3 2 2 ...
 $ KitchenAbvGr : int  1 1 1 1 1 1 1 1 2 2 ...
 $ KitchenQual  : chr  "Gd" "TA" "Gd" "Gd" ...
 $ TotRmsAbvGrd : int  8 6 6 7 9 5 7 7 8 5 ...
 $ Functional   : chr  "Typ" "Typ" "Typ" "Typ" ...
 $ Fireplaces   : int  0 1 1 1 1 0 1 2 2 2 ...
 $ FireplaceQu  : chr  NA "TA" "TA" "Gd" ...
 $ GarageType   : chr  "Attchd" "Attchd" "Attchd" "Detchd" ...
 $ GarageYrBlt  : int  2003 1976 2001 1998 2000 1993 2004 1973 1931 1939 ...
 $ GarageFinish : chr  "RFn" "RFn" "RFn" "Unf" ...
 $ GarageCars   : int  2 2 2 3 3 2 2 2 2 1 ...
 $ GarageArea   : int  548 460 608 642 836 480 636 484 468 205 ...
 $ GarageQual   : chr  "TA" "TA" "TA" "TA" ...
 $ GarageCond   : chr  "TA" "TA" "TA" "TA" ...
 $ PavedDrive   : chr  "Y" "Y" "Y" "Y" ...
 $ WoodDeckSF   : int  0 298 0 0 192 40 255 235 90 0 ...
 $ OpenPorchSF  : int  61 0 42 35 84 30 57 204 0 4 ...
 $ EnclosedPorch: int  0 0 0 272 0 0 0 228 205 0 ...
 $ X3SsnPorch   : int  0 0 0 0 0 320 0 0 0 0 ...
 $ ScreenPorch  : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PoolArea     : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PoolQC       : chr  NA NA NA NA ...
 $ Fence        : chr  NA NA NA NA ...
 $ MiscFeature  : chr  NA NA NA NA ...
 $ MiscVal      : int  0 0 0 0 0 700 0 350 0 0 ...
 $ MoSold       : int  2 5 9 2 12 10 8 11 4 1 ...
 $ YrSold       : int  2008 2007 2008 2006 2008 2009 2007 2009 2008 2008 ...
 $ SaleType     : chr  "WD" "WD" "WD" "WD" ...
 $ SaleCondition: chr  "Normal" "Normal" "Normal" "Abnorml" ...
 $ SalePrice    : int  208500 181500 223500 140000 250000 143000 307000 200000 129900 118000 ...
[1] 1460   81

2 VARIABLES

Row

ESTE TIPO DE VARIABLES SON CUANTIFICABLES.    PINCHE EL TIPO AL QUE QUIERE DIRIGIRSE

    Variables cuantificables.   Variables categoricas .   Variables cuantificadas

Row

.

Codigo Significado
ID Identidad
LotFrontage pies lineales de la calle conectados a la propiedad
LotArea Tamaño del lote en pies cuadrados
YearBuilt fecha de construcción original
YearRemodAdd fecha de remodelación
MasVnrArea área de chapa de la albañilería en pies cuadrados
BsmtFinSF1 Tipo 1 pies cuadrados terminados
BsmtFinSF2 Tipo 2 pies cuadrados terminados
BsmtUnfSF Pies cuadrados sin terminar del área del sótano
TotalBsmtSF pies cuadrados totales del área del sótano
1stFlrSF primer piso pies cuadrados
2ndFlrSF segundo piso pies cuadrados
LowQualFinSF Pies cuadrados terminados de baja calidad (todos los pisos)
GrLivArea pies cuadrados del área habitable sobre el nivel del suelo
BsmtFullBath baños completos en el sótano
BsmtHalfBath medio baño en el sótano
FullBath baños completos por encima del grado
HalfBath medio baño por encima del grado

.

Codigo Significado
Bedroom Número de habitaciones sobre el nivel del sótano
Kitchen Número de cocinas
TotRmsAbvGrd Total de habitaciones por encima del grado (no incluye baños)
Fireplaces cantidad de chimeneas
GarageYrBlt año de garaje fue construido
GarageCars tamaño del garaje en la capacidad del automóvil
GarageArea Tamaño del garaje en pies cuadrados
WoodDeckSF área de cubierta de madera en pies cuadrados
OpenPorchSF área de porche abierto en pies cuadrados
EnclosedPorch área de porche cerrado en pies cuadrados
3SsnPorch área del porche de tres estaciones en pies cuadrados
ScreenPorch área del porche de la pantalla en pies cuadrados
PoolArea área de la piscina en pies cuadrados
MiscVal $ Valor de la función miscelánea
MoSold Mes vendido
YrSold Año de venta
SalePrice el precio de venta de la propiedad en dólares.

3 VALORES NULOS Y PERDIDOS

Column

Veamos primero cuantos valores y en cuantas columnas tenemos NA

x
PoolQC 2909
MiscFeature 2814
Alley 2721
Fence 2348
SalePrice 1459
FireplaceQu 1420
LotFrontage 486
GarageYrBlt 159
GarageFinish 159
GarageQual 159
GarageCond 159
GarageType 157
BsmtCond 82
BsmtExposure 82
BsmtQual 81
BsmtFinType2 80
BsmtFinType1 79
MasVnrType 24
MasVnrArea 23
MSZoning 4
Utilities 2
BsmtFullBath 2
BsmtHalfBath 2
Functional 2
Exterior1st 1
Exterior2nd 1
BsmtFinSF1 1
BsmtFinSF2 1
BsmtUnfSF 1
TotalBsmtSF 1
Electrical 1
KitchenQual 1
GarageCars 1
GarageArea 1
SaleType 1

Column

Veamos un listado de los valores NA usados como categoria

Estaban marcados en rojo en su respectiva tabla

Alley

tipo de acceso a callejones

Codigo Significado
NA No alley access
BsmtQual

Altura del sótano

Codigo Significado
NA No Basement
BsmtCond

estado general del sótano

Codigo Significado
NA No Basement
BsmtExposure

muros de sotano a ras de suelo o de jardín

Codigo Significado
NA No Basement
BsmtFinType1

Calidad del área acabada del sótano

Codigo Significado
NA No Basement
BsmtFinType2

Calidad del segundo área terminada (si está presente)

Codigo Significado
NA No Basement
FireplaceQu

calidad de la chimenea

Codigo Significado
NA No Fireplace
GarageType

ubicación del garaje

Codigo Significado
NA No Garage
GarageFinish

acabado interior del garaje

Codigo Significado
NA No Garage
GarageQual

calidad de garaje

Codigo Significado
NA No Garage
GarageCond

condición de garaje

Codigo Significado
NA No Garage
PoolQC

calidad de la piscina

Codigo Significado
NA No Pool
Fence

calidad de la cerca

Codigo Significado
NA No Fence
MiscFeature

característica miscelánea no cubierta en otras categorías

Codigo Significado
NA None

Column

Podemos apreciar que en todas las variables donde aparece (Callejon, Sotanos, Garages, Piscinas, Cerca y Varios), el sentido que se le da es “Ninguno” o “No existe”.

Por lo que podemos cambiar el código en esas variables por NONE

Volvemos a comprobar cuantas columnas quedan con valores NA despues de la sustitucion

x
SalePrice 1459
LotFrontage 486
GarageYrBlt 159
MasVnrType 24
MasVnrArea 23
MSZoning 4
Utilities 2
BsmtFullBath 2
BsmtHalfBath 2
Functional 2
Exterior1st 1
Exterior2nd 1
BsmtFinSF1 1
BsmtFinSF2 1
BsmtUnfSF 1
TotalBsmtSF 1
Electrical 1
KitchenQual 1
GarageCars 1
GarageArea 1
SaleType 1

4 BUSQUEDA DETALLADA POR VARIABLES

Row

NOS QUEDAN VALORES NULOS POR CONCRETAR EN:

Row

PINCHE EN CADA VARIABLE PARA VER EN DETALLE .

GARAGE

   GarageYrBlt -->  159 registros        GarageCars -->   1 registros                     GarageArea -->  1 registros
SOTANO(BASEMENT)

BsmtFullBath -->  2 registros        BsmtHalfBath -->  2 registros                        BsmtFinSF1 -->  1 registro     BsmtFinSF2 -->  1 registro                                 BsmtUnfSF -->  1 registro    TotalBsmtSF -->  1 registro  
MAMPOSTERIA (MasVnr)

 MasVnrType -->  24 registros        MaVnrArea -->  23 registros  
PROPIEDAD (Lot)

 LotFrontage -->  486 registros
EXTERIOR

 Exterior1st -->  1 registro        Exterior2nd -->   1 registro

PINCHE EN CADA VARIABLE PARA VER EN DETALLE .

UTILIDADES (Utilities)

 Utilities -->  2 registros
FUNCIONAL (Functional)

 Functional -->  2 registros
ELECTRICO (Electrical)

 Electrical -->  1 registro
COCINA (Kitchen)

 KitchenQual -->  1 registro
VENTA (Sale)

 SaleType -->  1 registro
ZONIFICACION

 MSZoning -->  4 registro

CONCLUSION

5. CONTRADICCIONES

Vamos a buscar contradicciones entre características similares

Row

PISCINA (Pool)



No se puede establecer una relacion directa entre la calidad de la piscina y el area.

Buscaremos en la calidad general de la casa

Id PoolQC PoolArea
2421 NONE 368
2504 NONE 444
2600 NONE 561



Tenemos tres registros que tienen un area de piscina sin tenerla

Vemos como están distribuidas las piscinas
Var1 Freq
NONE 2909
Ex 4
Gd 4
Fa 2


La gran mayoría de las casas no tienen piscina. De esas 10 que si tienen mas las tres que nos faltan hay que poder encontrar un criterio con el que dar una cualificación a los registros que faltan. Buscaremos algún tipo de relación
Id PoolQC PoolArea OverallQual OverallCond
198 Ex 512 8 4
811 Fa 648 6 6
1171 Gd 576 6 6
1183 Ex 555 10 5
1299 Gd 480 10 5
1387 Fa 519 7 5
1424 Gd 738 6 7
1975 Ex 144 10 5
2421 NONE 368 4 6
2504 NONE 444 6 5
2574 Ex 228 8 5
2600 NONE 561 3 5
2711 Gd 800 7 4



Parece que existe cierta relacion entre la calidad general y el area de piscina Vamos a verlo numericamente . Llamo razon a la proporcion OverallQual*100/PoolArea
Id PoolQC PoolArea OverallQual OverallCond razon
1975 Ex 144 10 5 6.944
2574 Ex 228 8 5 3.509
1299 Gd 480 10 5 2.083
1183 Ex 555 10 5 1.802
198 Ex 512 8 4 1.562
2504 NONE 444 6 5 1.351
1387 Fa 519 7 5 1.349
2421 NONE 368 4 6 1.087
1171 Gd 576 6 6 1.042
811 Fa 648 6 6 0.926
2711 Gd 800 7 4 0.875
1424 Gd 738 6 7 0.813
2600 NONE 561 3 5 0.535



Si se puede establecer una cierta relación , por lo que asignamos la calidad de la piscina asi, teniendo en cuenta que good Gd es mejor que fair Fa

total[2504,73]<-'Gd'
total[2421,73]<-'Gd'
total[2600,73]<-'Fa'

CHIMENEA (Fireplace)



No existe contradiccion entre el numero de chimeneas y la calidad



nrow(total%>%filter(Fireplaces>0 & FireplaceQu=='NONE')%>%select(Id,Fireplaces,FireplaceQu,OverallQual,OverallCond))
[1] 0



SOTANO (Basement)



En las areas tenemos que el area del tipo 1 + area del tipo 2 + area sin terminar = Area total

Comprobamos y buscamos incongruencias

prueba<-total%>%select(Id,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
prueba[,2]<--prueba[,2]
prueba[,6]<-apply(prueba[,2:5],1,sum)
nrow(prueba%>%filter(V6>0))
[1] 0

No existe ningun registro con el area mal



En los registros sin sotano compruebo que no exista algún campo que no corresponda

Existen 79 registros que no tienen sotano

prueba<-total%>%filter(BsmtQual=='NONE'|BsmtCond=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
prueba1<-prueba%>%filter(BsmtQual!='NONE'|BsmtCond!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'|BsmtFullBath>0|BsmtHalfBath>0)%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
nrow(prueba1)
[1] 0

Ninguno de ellos tiene incongruencias



Busco los sotanos existentes que no tienen area construida en el primer tipo

prueba<-total%>%filter(BsmtFinType1!='NONE' & BsmtFinSF1==0 )%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
table(prueba$BsmtFinType1,prueba$BsmtFinType2)
     
      Unf
  Unf 851



Esos 851 no tiene tampoco del segundo tipo Unf

table(prueba$BsmtFinSF1,prueba$BsmtFinSF2)
   
      0
  0 851



Las areas son 0 en todos los casos

nrow(prueba%>%filter(prueba$BsmtUnfSF==0))
[1] 0



Todos los registros aparecen como Unf Inacabado. Es correcto

GARAGE



En los inmuebles sin garaje buscamos registros que tengan campos con contradicciones o incongruencias

prueba<-total%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE')%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
[1] 0



En los inmuebles con garaje buscamos registros que tengan campos con contradicciones o incongruencias

prueba<-total%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE' | GarageYrBlt==0 | GarageCars==0 | GarageArea==0)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
[1] 0



6. TIPOLOGIAS

Column

CATEGORICAS



Teniendo en cuenta que para el análisis con las variable independientes categóricas se crearan variables “dummy”, tantas como categorías-1 por cada variable, parece claro pensar que favorece reducir el numero de variables, reduciendo la complejidad.

En nuestro caso , y en mi opinión es posible realizarlo cambiando ciertas variables de categóricas a ordinales. Sobre todo en aquellas que tengan un orden que parezca lógico.

Para seguir un criterio razonable, he escogido la transformación creciente desde 0 hasta el numero de categorías dentro de cada variable, siempre desde menos a mas, o si se prefiere de peor a mejor, pero con la salvedad de que 0 solo se escoge para la categoría que significa que no existe esa variable.

Por simplificar con un ejemplo, puedo tener una variable que me habla de la calidad del acabado del garaje, dentro de las cuales tengo varias categorías que van desde una mala calidad a una muy buena. Evidentemente el orden es creciente con el máximo valor para la mejor de las categorías, pero el 0 se reserva solo si dentro de esas categorías me aparece una indicando que no tiene garaje

Estas son las variables categóricas que he seleccionado, y al lado la asignación que le doy a cada categoría de cada una de ellas

VER

ORDINALES



Vamos a revisar las variables que ya teníamos como ordinales en los datos originales


Mientras que OverallQual y OverallCond no ofrecen ninguna duda, MSSubclass me parece que no esta correctamente planteada.


Puede que se usara ese código numerico para identificar mejor las distintas clases de edificación pero no tiene una relación ordinal


Se puede apreciar en el grafico con la relación que tiene con el precio


VER

CUANTITATIVAS

En el caso de variables cuantitativas originalmente en el dataset , vamos a revisar aquellas que no tengan justificación como numericas

Antes de empezar voy a revisar la normalidad de las variables cuantitativas para lo cual he creado un pequeño codigo que me indica la normalidad SI o NO de las variables


NO 
38 

El resultado es que ninguna de las variables numéricas tienen normalidad. Esto me sirve para seleccionar el método de correlacion de Spearman

Vemos las variables cuantitativas susceptibles de cambiarse a categoricas

En principio voy a revisar aquellas cuya cantidad represente algo en si misma, y en esta categoría entran todo lo referido a fechas. Repasando una por una

En la categoria de fechas se encuentran las 4 primeras

MOSOLD (Mes venta)

YRSOLD (Año venta)

YearBuilt YearRemodAdd (Año de construccion y Año de remodelacion)

GarageYrBuilt (Año en el que fue construido el garage)


Veremos a continuacion el resto de variables cuantitativas y relación entre ellas para poder ver si reducimos su numero.

Voy a crear una matriz de correlaciones entre estas variables sin contar en principio con el precio.

Para saber si existe una dependencia entre algunas de ellas que nos pueda servir.

Para eso uso el paquete corrplot

Esta es la revision general

REVISION RESTO CUANTITATIVAS (Sin relacion con fechas)


Vere a continuación las variables con una fuerte correlacion por si se puede reducir el numero de variables predictoras

ANTIGUEDAD y ANTGARAGE

GARAGECARS Y GARAGEAREA

FIREPLACES y FIREPLACEQU

1STFlRSF y TOTALBSMTSF

GRLIVAREA FULLBATH TOTRMSABVGRD

Normalizacion de resto de variables

CONCLUSION

Todos estos epigrafes se encuentran ademas en el menu 2 PREPARACION

FACTORES

En el caso del estudio de las variables categóricas, tenemos que partir de un enfoque diferente


Como estamos hablando de variables categóricas no podemos en principio calcular un valor directo como usábamos el de la correlacion en las variables continuas.


Pero si podemos usar el coeficiente de determinación o bondad del ajuste que en los casos de regresion lineal simple es el cuadrado de la correlacion de Pearson.


Luego la forma de seleccionar aquellas variables que tienen influencia sobre el precio va a ser calcular el coeficiente de determinación


Para facilitar esto vamos a usar el paquete FactoMineR.


Esta todo detallado en el menu 3 PREPARACION

1. MOSOLD

Vemos como se distribuye


En azul el total de viviendas, y por encima en rojo solo el conjunto de entrenamiento.

No parece que haya excesivas diferencias y en la mayoría de los meses se aprecia visualmente que el conjunto de entrenamiento representa la mitad del total.

Podemos apreciar que la numeración se refiere evidentemente a los meses y refleja una distribución en la venta superior en los meses de Mayo, Junio y Julio.

Veamos si eso afecta a el precio de venta en el conjunto Train


El precio medio es parecido y no se ve relación con el mes (por encima aparece la cantidad)

Boxplot

Vemos correlacion

cor(x=TrainNum$MoSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
[1] 0.0694322

En mi opinión con esa correlacion tan próxima a 0 no influye para nada en el precio

2. YRSOLD

Tenemos un total de cuatro años. Veamoslo gráficamente al igual que con los meses

La media por año con el numero de casos

Boxplot

Vemos correlacion

cor(x=TrainNum$YrSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
[1] -0.0298991

Tienen una correlacion cercana a 0 lo cual indica una influencia en el precio infima

Tiene la particularidad de que nos puede servir para considerar la antigüedad de la vivienda y ahí puede ser relevante su uso.

Voy a posponerlo para mas adelante cuando veamos el año de construcción y el de remodelación

3. YEARBUILT YEARREMODADD

Vamos a ver gráficamente la relación con el precio de venta del año de construccion


Vemos estas dos variables puesto que están muy relacionadas.

El año de construccion no necesita explicación, en cuanto a el año de remodelacion es el año en que la vivienda ha sufrido algún tipo de reforma.

Si no ha tenido ninguna esta se corresponde con la fecha de construcción.

Vemos ahora para el año de remodelación


Tiene la peculiaridad de que computa a partir de 1950, y en ese año tiene un numero extraordinario de casos, 178 en el Train y 361 en el total, seguramente porque se empezaría a computar ese año y todas las que tienen una antigüedad mayor se computan aqui

Parece razonable pensar a la vista de las graficas que existe algún tipo de relación con el precio de venta. Numericamente:

#Correlacion año construccion
cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
[1] 0.652682
#Correlacion año remodelacion
cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
[1] 0.571159

¿Que pasaria si distinguimos aquellas casas que han sido remodeladas , y por lo tanto su fecha de remodelacion es diferente a la de construccion, de aquellas que no lo han sido?

Prueba de remodelacion.
Creamos una columna.
No remodelados=0. Remodelados=1

#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
[1] 0.643186
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
[1] 0.478056
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
[1] 0.680097

Esta claro que importa el año de construccion, importa el año de remodelacion, importa si estan o no remodeladas en cuanto afecta a su antigüedad y además tenemos unos valores extraños en 1950 que debemos corregir.

Voy a considerar que ninguna de esas viviendas situadas en 1950 han sido remodeladas por lo que aplicare a esa variable, la del año de construcción

Aplico a la remodelacion de los de 1950 el año de construccion y recalculamos

#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
[1] 0.613344
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
[1] 0.229517
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
[1] 0.708576

Graficamente


Vamos a afinar un poco mas calculando la antigüedad respecto al año de venta. Creamos una columna nueva

Calculo antiguedad completa y comprobamos posibles errores

Id YearBuilt YrSold
2550 2008 2007
total[2550,78]<-2008

Existe un registro con el año de venta anterior al de la construccion. Lo igualo

Buscarè errores también en el año de remodelación

Revision de incongruencia de datos con YearRemodAdd

Id YrSold YearBuilt YearRemodAdd
524 2007 2007 2008
2296 2007 2007 2008
2550 2008 2008 2009
total[524,21]<-2007
total[2296,21]<-2007
total[2550,21]<-2008

Corrijo los valores del año de remodelacion posteriores al año de construccion y venta, y pongo los valores de este ultimo

Mas incongruencias

Id YrSold YearBuilt YearRemodAdd
1877 2009 2002 2001
total[1877,21]<-2002

El año de remodelacion es anterior al de construccion

Corrijo los valores al año de construccion

Volvemos a calcular y actualizar

#Calculamos correlacion para remodelados
cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete")
[1] -0.612723
#No remodelados
cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete")
[1] -0.706995

Al cambiar el calculo sobre la antiguedad se invierte el signo de la correlacion

Graficamente la antiguedad


Los valores son parecidos pero al calcular sobre el numero de años se invierte el signo

En conclusión, la antigüedad de la vivienda tiene una relación fuerte con el precio de venta, y además el hecho de ser una vivienda remodelada o no tambien es importante.

Le afecta menos cuando se ha realizado dicha remodelación.

Por lo cual calculamos la antigüedad (ya realizado), calculamos si hay o no remodelación

#Conclusiones
total$Remodelado<-0
total$Remodelado[total$YearBuilt!=total$YearRemodAdd]<-1
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]

Si calculamos la correlacion de la antiguedad respecto al precio tenemos un valor -0.65012.

Hemos visto que los remodelados tienen -0.612723 y los no remodelados -0.706995 lo que significa que están penalizados por el calculo conjunto.

Podriamos pensar que si tomamos la antigüedad como la diferencia entre el año de venta y el de remodelación(teniendo en cuenta que para las viviendas no remodeladas este es igual que el de construcción) obtendríamos una variable mas adecuada, pero es al contrario , el valor de la correlacion es -0.575787.

Hay que encontrar una manera de penalizar a las viviendas remodeladas en su antigüedad

Mi propuesta es penalizar a las viviendas que han sido remodeladas aumentando su antigüedad de manera artificial.

Proporcionalmente al tiempo que se ha tardado en remodelar. ¿Cuánto?. La decima porcentual que tienen de diferencia las correlaciones.

Vemos los valores y penalizamos

#Penalizacion
TotalNum.remo<-TotalNum%>%filter(Remodelado==1)
summary(TotalNum.remo$YearRemodAdd-TotalNum.remo$YearBuilt)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    1.0     1.0    20.0    29.9    52.0   127.0 
total$Penaliza<-total$YearRemodAdd-total$YearBuilt
#Normalizo y penalizo
total$Antiguedad<-normalize(total$Antiguedad)
total$Penaliza<-normalize(total$Penaliza)
total$Antiguedad<-total$Antiguedad+total$Penaliza*0.1
#Borro las variables auxiliares Remodelado y Penaliza
total$Remodelado<-NULL
total$Penaliza<-NULL
#Vemos correlacion nueva variable Antiguedad
cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
[1] -0.65012

Creo una columna donde pongo este calculo

Como la antiguedad la tenemos en enteros y para ser justo con la penalizacion voy a normalizar las variables

Luego le aplicare un 10% de la antigüedad de la remodelación a la antigüedad de la vivienda


La correlacion de Antiguedad es de -0.641654

Partiamos de una correlacion de Año Construccion de 0.652682 y en Año Remodelacion de 0.570737

Nos hemos acercado a la mas alta pero reduciendo a la mitad el numero de variables

4. GARAGEYRBUILT

Eliminamos los valores igual a 0, o sea que no tienen garaje. Ya comprobamos anteriormente la congruencia de los registros. Vemos gráficamente


Tenemos un outlier. Corresponde al registro 2593.

Vamos a ver los datos pertinentes y modificamos

Id GarageType GarageYrBlt GarageFinish GarageQual GarageArea GarageCond GarageCars YearBuilt YearRemodAdd YrSold
2593 Attchd 2207 2 3 502 3 2 2006 2007 2007
total[2593,60]<-2007

Podemos inferir que el año real de construcción del garaje es 2007 y no 2207.

Recalculamos y volvemos a observar

Verifico que el año de construcción del Garage sea posterior al de la casa. Ponemos el año como el de la vivienda en los que no lo sea

Id YearBuilt GarageYrBlt
30 1927 1920
94 1910 1900
325 1967 1961
601 2005 2003
737 1950 1949
1104 1959 1954
1377 1930 1925
1415 1923 1922
1419 1963 1962
1522 1959 1956
1577 2010 2009
1806 1935 1920
1841 1978 1960
1896 1941 1940
1898 1935 1926
2123 1945 1925
2264 2006 2005
2510 2006 2005
total$GarageYrBlt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]<-total$YearBuilt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]

#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

Hay 18 registros que tienen el año de construccion del garage anterior al de la vivienda. Entiendo que se debe a errores tipográficos, como confundir un 4 por un 9 o diferencias pequeñas de tiempo que hacen variar en un año

Veamos la relación con el precio


Podemos pensar que parece existir una relación.

Numericamente

cor(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice,method="spearman",use="na.or.complete")
[1] 0.594246

Hay que tener en cuenta que no he incluido los registros que no tienen garaje.

Si se les incluye, curiosamente la correlacion aumenta.

De todas formas es interesante realizar como con la variable anterior, calcular la antigüedad

#Calculo antiguedad Garaje
total$AntGarage<-total$YrSold-total$GarageYrBlt
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

#Correlacion
cor(x=TrainNum$AntGarage,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
[1] -0.63301

Y graficamente


Todo el grupo de observaciones que se ve a la derecha son aquellos que no tienen garage y les sale como antiguedad tanta como el año de venta. Eso les supone una penalizacion

En conclusion para las variables YearBuilt, YearRemodAdd, MoSold, YrSold y GarageYrBlt nos quedamos con Antigüedad y AntGarage como variables importantes para el precio de venta

5. REVISION RESTO CUANTITATIVAS

Primero la correlacion de las variables entre si, sin contar con el precio ni las variables ya tratadas


Se ve claramente dependencia en ciertos grupos de variables.





















Antes de seguir vamos a ver la correlacion de las variable significativas (superior a 0.5 en términos absolutos) respecto al Precio


En el grafico en la fila inferior tenemos SalePrice.

En rojo las variables con correlacion negativa :

 AntGarage    Antigüedad

En azul las variables predictoras con correlacion positiva:

 GarageArea      GarageCars

 Fireplaces    FireplaceQu

 X1stFlrSF     TotalBsmtSF

 TotRmsAbvGrd  GrLivArea   FullBath

 GarageFinish

 KitchenQual

 BsmtQual

 ExterQual

 OverallQual



Las variables que pongo juntas tienen una correlacion fuerte (ver primer grafico ) entre ellas y cierta explicacion lógica.



6. ANTIGUEDAD y ANTGARAGE



Es evidente que tiene una gran correlacion porque en cierta medida su valor crece de manera proporcionada.


Si una vivienda tiene un garaje, la antigüedad del garaje crece de igual manera que la antigüedad de la vivienda y suelen ser iguales salvo que el garaje se haya construido después.


De todas formas no soy partidario de unirlas de alguna forma porque la variable AntGarage tiene la peculiaridad de aquellas viviendas sin garaje que hay que mantener


Solo voy a normalizar la varable AntGarage, puesto que Antigüedad ya lo estaba


total$AntGarage<-normalize(total$AntGarage)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



7. GARAGECARS Y GARAGEAREA



A pesar de que tienen relación con otras variables la mas importante es entre ellos, y puede parecer lógico puesto que el numero de coches que pueda entrar en un garaje depende directamente del espacio que este tenga

Primero normalizo las variables según función
TotalNum$GarageArea<-normalize(TotalNum$GarageArea)
TotalNum$GarageCars<-normalize(TotalNum$GarageCars)
cor(x=TotalNum$GarageArea,y=TotalNum$GarageCars,method = 'spearman')
[1] 0.864929


La relacion es positiva. Ambas tienen una correlacion positiva y parecida con respecto al precio
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

cor(x=TrainNum$GarageArea,y=TrainNum$SalePrice,method = 'spearman')
[1] 0.649379
cor(x=TrainNum$GarageCars,y=TrainNum$SalePrice,method = 'spearman')
[1] 0.690711



La opcion que opto es multiplicar ambas variables puesto que GarageCars es discreta y GarageArea es continua.

La nueva variable GARAGETOTAL se convierte en continua, mantiene la normalización y el valor 0 para los que no tienen garaje
TrainNum$Garage2<-TrainNum$GarageArea*TrainNum$GarageCars
cor(x=TrainNum$Garage2,y=TrainNum$SalePrice,method = 'spearman')
[1] 0.668591

Es una correlacion media de las otras dos.
Normalizo y actualizo

total$GarageTotal<-normalize(total$GarageArea)*normalize(total$GarageCars)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



8. FIREPLACES y FIREPLACEQU

Column

Fireplaces es el numero de chimeneas

FireplacesQu es la calidad según vimos cuando se paso de categorica a ordinal

La correlacion positiva entre ellas nos indica que a medida que el numero de chimeneas aumenta también aumenta la calidad

cor(x=total$Fireplaces,y=total$FireplaceQu,method = 'kendall')
[1] 0.820617


Con respecto al precio

cor(x=TrainNum$FireplaceQu,y=TrainNum$SalePrice,method='spearman')
[1] 0.537602
cor(x=TrainNum$Fireplaces,y=TrainNum$SalePrice,method='spearman')
[1] 0.519247


La correlacion con el precio no es muy alta y ademas la correlacion entre ellas es altisima, por lo que me quedo con una y descarto la otra

Me quedo con FireplaceQu. Y la normalizo

total$FireplaceQu<-normalize(total$FireplaceQu)

Column

Ademas es una relacion fuerte. Vemos un grafico



9. 1STFlRSF y TOTALBSMTSF

La correlacion entre ellos es bastante alta

cor(x=total$X1stFlrSF,y=total$TotalBsmtSF,method='spearman')
[1] 0.828737



summary(total$X1stFlrSF)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    334     876    1082    1160    1388    5095 
summary(total$TotalBsmtSF)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      0     793     989    1051    1302    6110 

1stFlrSF corresponde al área del primer piso.

TotalBsmtSF es el área del sotano

Se presupone que las viviendas que tienen sotano , por lo general el área en planta del sotano es igual que el de la primera planta.

La diferencia por lo general esta en que todas las viviendas tienen primera planta, pero no todas tienen sotano

Vemos un grafico esclarecedor


Se aprecian dos líneas claramente, una siguiendo el eje de abscisas en o que son las viviendas sin sotano y la otra línea de inclinación 45º que son las viviendas que tienen el mismo área de vivienda que de sotano.

Hay que destacar que hay unas cuantas viviendas que tienen mas área de sotano que de primer piso

Vemos su correlacion con el precio

cor(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice,method='spearman')
[1] 0.575408
cor(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice,method='spearman')
[1] 0.602725

No parece que haya una correlacion muy alta .

Vemos la corelacion con el precio gráficamente

Tenemos dos outliers en la esquina inferior derecha. Les busco y excluyo estos valores para ver si mejora

Id X1stFlrSF TotalBsmtSF SalePrice
524 3138 3138 184750
1299 4692 6110 160000



TrainNum.piso<-TrainNum%>%filter(Id!=524)%>%filter(Id!=1299)

Vemos de nuevo


El grafico parece que ha mejorado. Veamos numéricamente

cor(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice,method='spearman')
[1] 0.576221
cor(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice,method='spearman')
[1] 0.603604



#Separo las viviendas por el sotano
TrainNum.sot<-TrainNum%>%filter(TotalBsmtSF==0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)
TrainNum.piso<-TrainNum%>%filter(TotalBsmtSF>0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)

Sí hay mejoria pero no parece significativa.

En principio no descarto estos registros por si afectan a otras variables

Voy a separar en la variable de área de primera planta a las viviendas que tienen sotano y las que no

Vemos graficamente


Se aprecia que las vivendas sin sotano (puntos rojos) por lo general están penalizadas en el precio, casi todas están en la parte baja de la nube.

En mi opinión se debería combinar ambas variables pero que penalizen a las viviendas sin sotano, parecido a lo que sucedia a la penalizacion en la antigüedad.

Para eso voy a sumar el área del sotano y el de la primera planta

La mayoría de las viviendas verán casi doblada su superficie, pero las viviendas sin sotano se quedan como están

Vemos graficamente

Numericamente

[1] 0.623865



total$AreaPiso<-normalize(total$X1stFlrSF+total$TotalBsmtSF)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

La correlacion mejora

La distribución parece bastante parecida.

Dejamos asi la nueva variable y la normalizamos

10. GRLIVAREA FULLBATH TOTRMSABVGRD

Vemos la correlacion entre las tres

GrLivArea FullBath TotRmsAbvGrd
GrLivArea 1.000000 0.662752 0.808775
FullBath 0.662752 1.000000 0.536076
TotRmsAbvGrd 0.808775 0.536076 1.000000

Estas variables corresponde a

     GrLivArea   pies cuadrados del área habitable sobre el nivel del suelo            

 FullBath       baños completos por encima del suelo          

 TotRmsAbvGrd    Total de habitaciones por encima del suelo (no incluye baños)

Parece evidente una relación lógica entre la primera variable y las otras dos

Graficamente


En rojo el numero de baños y en azul el total de estancias por encima del nivel del suelo.

Todo en funcion del precio de venta de la casa

Tenemos dos outliers que con un area habitable superior a 5000 y con 12 y 15 habitaciones solo tiene 2 baños

Id GrLivArea FullBath TotRmsAbvGrd
1299 5642 2 12
2550 5095 2 15
[1] "Correlacion sin outliers"
GrLivArea FullBath TotRmsAbvGrd
GrLivArea 1.000000 0.662584 0.808373
FullBath 0.662584 1.000000 0.535749
TotRmsAbvGrd 0.808373 0.535749 1.000000
[1] "Correlacion con outliers"
GrLivArea FullBath TotRmsAbvGrd
GrLivArea 1.000000 0.662752 0.808775
FullBath 0.662752 1.000000 0.536076
TotRmsAbvGrd 0.808775 0.536076 1.000000

Les descarto y compruebo como queda la matriz de correlacion

Parece que incluso ha empeorado con respecto al anterior (se muestra mas abajo)

Pero voy a verlo teniendo en cuenta el precio

[1] "Correlacion con outliers"
GrLivArea FullBath TotRmsAbvGrd SalePrice
GrLivArea 1.000000 0.658419 0.827874 0.731310
FullBath 0.658419 1.000000 0.558665 0.635957
TotRmsAbvGrd 0.827874 0.558665 1.000000 0.532586
SalePrice 0.731310 0.635957 0.532586 1.000000
[1] "Correlacion sin outliers"
GrLivArea FullBath TotRmsAbvGrd SalePrice
GrLivArea 1.000000 0.658246 0.827514 0.732112
FullBath 0.658246 1.000000 0.558364 0.636043
TotRmsAbvGrd 0.827514 0.558364 1.000000 0.533215
SalePrice 0.732112 0.636043 0.533215 1.000000

Se puede observar como al quitar los outliers la correlacion entre las variables que estudiamos empeoran pero mejoran todas con respecto al precio.

Lo dejamos en recordatorio como los otros outliers que hemos visto para más adelante

Podemos pensar que si consideramos los baños como una estancia mas podemos unirlo en una sola variable

Id HalfBath BsmtFullBath BsmtHalfBath
54 1 2 0
189 2 2 0
376 1 1 0
598 2 0 2
635 0 2 0
917 0 1 0
1164 2 2 0
1214 0 1 1
1271 1 2 0
1860 2 2 0
2514 1 2 0
2601 1 2 0

Pregunta: ¿Qué significa que haya viviendas que no tengan baño?

Respuesta: Que tienen medios baños o baños en el sotano

En la tabla las casas que no tienen baño

Esta es la grafica de la relación entre los baños y el precio


Las vivendas sin baño están penalizadas en el precio aunque no demasiado

Si sumamos los baños como una estancia mas

#Sumamos los baños
TotalNum$estancias<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd
GrLivArea FullBath TotRmsAbvGrd estancias
GrLivArea 1.000000 0.662752 0.808775 0.852309
FullBath 0.662752 1.000000 0.536076 0.743707
TotRmsAbvGrd 0.808775 0.536076 1.000000 0.960388
estancias 0.852309 0.743707 0.960388 1.000000

Evidentemente la correlacion con las variables que la componen tiene que ser alta, pero con el area habitable mejora bastante la correlacion individual mejor que tenia antes

La correlacion de GrLivArea con FullBath es 0.662752 y con TotRmsAbvGrd es 0.808775

Con la nueva variable estancias es 0.852309

Voy a sumarle también los medios baños pero reducido a la mitad en su valor

#Sumamos los medios baños
TotalNum$estancias2<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd+(TotalNum$HalfBath/2)
GrLivArea FullBath TotRmsAbvGrd estancias estancias2
GrLivArea 1.000000 0.662752 0.808775 0.852309 0.865065
FullBath 0.662752 1.000000 0.536076 0.743707 0.723524
TotRmsAbvGrd 0.808775 0.536076 1.000000 0.960388 0.958442
estancias 0.852309 0.743707 0.960388 1.000000 0.991040
estancias2 0.865065 0.723524 0.958442 0.991040 1.000000

Aunque empeora la correlacion con las otras variables, mejora con el area habitable que es con la que voy a combinarla y normalizarlas

Combino todo y normalizo

#Combinar con area habitable y normalizar
TotalNum$Habitat<-normalize(TotalNum$estancias2*TotalNum$GrLivArea)
#Comparamos con precio
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
GrLivArea FullBath TotRmsAbvGrd estancias Habitat SalePrice
GrLivArea 1.000000 0.658419 0.827874 0.860974 0.974100 0.731310
FullBath 0.658419 1.000000 0.558665 0.751499 0.714628 0.635957
TotRmsAbvGrd 0.827874 0.558665 1.000000 0.964700 0.916140 0.532586
estancias 0.860974 0.751499 0.964700 1.000000 0.948747 0.618233
Habitat 0.974100 0.714628 0.916140 0.948747 1.000000 0.704260
SalePrice 0.731310 0.635957 0.532586 0.618233 0.704260 1.000000
#Crear variable y normalizar
total$Habitat<-normalize((total$FullBath+total$TotRmsAbvGrd+(total$HalfBath/2))*total$GrLivArea)

Como el numero de estancias es cuasidiscreto (por tener medios baños) y el area habitable es continuo multiplico ambos para obtener una nueva variable Habitat continua

La nueva variable esta mucho mas correlacionada con las tres variables originales y además se acerca bastante a la variable original de mayor correlacion con el precio

Creamos en dataset conjunto y normalizamos



11. NORMALIZACION DE RESTO DE VARIABLES

 GarageFinish    acabado interior del garaje

 KitchenQual   calidad de la cocina

 BsmtQual    Altura del sótano

 ExterQual   calidad del material exterior

 OverallQual   material general y calidad de acabado



Son todas variables ordinales que indican distintos acabados/calidades de la vivienda

Es razonable pensar que junto con otras variables que no aparecen por no estar tan relacionadas, mantengan una correspondencia al nivel general de calidad de la vivienda y este está asociado al precio de manera importante.

En mi opinión no tiene justificación lógica el combinar varias de estas variables puesto que no tienen una relación causal a pesar de que tengan una correlacion importante

Las normalizamos

total$GarageFinish<-normalize(total$GarageFinish)
total$KitchenQual<-normalize(total$KitchenQual)
total$BsmtQual<-normalize(total$BsmtQual)
total$ExterQual<-normalize(total$ExterQual)
total$OverallQual<-normalize(total$OverallQual)

12. CONCLUSION



De todas las variables cuantitativas nos quedamos con las siguientes:



 Antiguedad    AntGaraje   GarageTotal   FirePlaceQu   AreaPiso    Habitat   GarageFinish    KitchenQual      BsmtQual    ExterQual   OverallQual



De un total de 51 variables numéricas del dataset (excluyendo la identificación Id y el precio de venta SalePrice) hemos reducido las variables predictoras a 11



1. TIPOFACTORES

Column

CONDICIONES PREVIAS

El paquete FactoMineR tiene varias opciones interesantes para realizar distintas métodos de analisis de datos y entre ellos tiene un método llamado condes() que sirve para describir una variable continua en función de variables continuas y/o categóricas

#Buscamos categorias mas proximas a SalePrice
options(digits=12)
fact1<-condes(TrainFact,num.var = 30)


Esto nos genera una lista de tres elementos (como maximo)

  • Una matriz con las variables cualitativas ordenadas por

  • Una matriz con las variables cuantitativas ordenadas por correlacion

  • Una matriz con los coeficientes de cada categoría de las variables cualitativas que cumplen con el p-value asignado

    Nuestro interés esta en la primera matriz.

    Teniendo en cuenta que para la selección de las variables cuantitativas significativas poníamos como criterio que la correlacion debía ser superior a 0.5, entonces en este caso > (0.5)²=0.25 .

    Ese es el limite que ponemos

VARIABLES


Estas son las variables

#Estas son las variables
fact1.cuali<-as.data.frame(fact1[[1]])
R2 p.value
Neighborhood 0.545574990810 0.000000000000
Foundation 0.256368401530 0.000000000000
GarageType 0.249204230504 0.000000000000
MSSubClass 0.246315972818 0.000000000000
MasVnrType 0.180235182646 0.000000000000
SaleCondition 0.135497476871 0.000000000000
Exterior1st 0.152773123142 0.000000000000
Exterior2nd 0.153829860125 0.000000000000
SaleType 0.137287486979 0.000000000000
MSZoning 0.107559683446 0.000000000000
HouseStyle 0.086312627304 0.000000000000
CentralAir 0.063165845939 0.000000000000
Electrical 0.059650931845 0.000000000000
PavedDrive 0.054539728331 0.000000000000
RoofStyle 0.057696630128 0.000000000000
Fence 0.035614716819 0.000000000094
BldgType 0.034534026889 0.000000000206
LandContour 0.025794085461 0.000000027422
RoofMatl 0.031413123044 0.000000072314
Condition1 0.032630639960 0.000000089045
Alley 0.020407544901 0.000000299638
LotConfig 0.021019364538 0.000003163167
Functional 0.016480385721 0.000484169680
Heating 0.014437135426 0.000753472106
MiscFeature 0.007079752947 0.035003671875
Condition2 0.009899160716 0.043425658361

RESUMEN

Si vemos las variables solo hay dos que superan un de 0.25, pero teniendo en cuenta que como en las variables numéricas no había normalidad y para la correlacion use el método de Spearman que suele dar un valor ligeramente superior al de Pearson, en este caso voy a escoger también las dos variables que se han quedado a las puertas con 0.24

En resumen :

 `Neighborhood`  ubicaciones físicas dentro de los límites de la ciudad de Ames
                    Tiene 25 categorias

 `MSSubClass`    la clase de construcción.   Tiene 16 categorias

 `Foundation`    tipo de cimientos.      Tiene 6 categorias

 `GarageType`    ubicación del garaje        Tiene 7 categorias


Son un total de 54 categorias.

Si usamos one hot encoding suponen (25-1)+(16-1)+(6-1)+(7-1)=50 nuevas variables a añadir a las 11 numericas que ya tenemos.

Hay que reducirlas

Las revisamos

2. NEIGHBORHOOD (Vecindario)

Esta variable tiene 25 categorias. Veamos grafica y ordenadamente por la media


En cada columna aparecen las observaciones

Veamos grafica y ordenadamente por la mediana


En cada columna aparecen las observaciones

Voy a intentar reducir las variables.

Para eso voy a utilizar una clasificación jerarquica aglomerativa sencilla mediante hclust

Voy a realizar varias clasificaciones y recalcular el coeficiente de determinación que quedaria antes de decidir .

Los clusters que elegimos van de 3 a 8 agrupaciones

Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES

Dendograma segun medias

Dendograma segun medianas

3. FOUNDATION (Cimientos)

Esta variable tiene 6 categorias. Veamos grafica y ordenadamente por la media


En cada columna aparecen las observaciones

Veamos grafica y ordenadamente por la mediana


En cada columna aparecen las observaciones

Realizamos la misma operación que con el vecindario, solo que aquí tenemos 6 grupos por lo que los cluster que elegimos van de 2 a 5

Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES

Dendograma segun medias

Dendograma segun medianas

4. GARAGETYPE (Ubicacion del garage)

Esta variable tiene 7 categorias. Veamos grafica y ordenadamente por la media y la mediana


En cada columna aparecen las observaciones

Veamos grafica y ordenadamente por la mediana


En cada columna aparecen las observaciones

Realizamos la misma operación que con el vecindario, solo que aquí tenemos 7 grupos por lo que los cluster que elegiremos van de 2 a 5

Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES

Dendograma segun medias

Dendograma segun medianas

5. MSSUBCLASS (CLase de construccion)

Esta variable tiene 16 categorias. Veamos grafica y ordenadamente por la media


En cada columna aparecen las observaciones

Veamos grafica y ordenadamente por la mediana


En cada columna aparecen las observaciones

Esta variable es mas peculiar.

Veamosla mas detenidamente

Vemos sus categorías y apariciones

Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 536
1-STORY 1945 & OLDER 69
1-STORY W/FINISHED ATTIC ALL AGES 4
1-1/2 STORY - UNFINISHED ALL AGES 12
1-1/2 STORY FINISHED ALL AGES 144
2-STORY 1946 & NEWER 299
2-STORY 1945 & OLDER 60
2-1/2 STORY ALL AGES 16
SPLIT OR MULTI-LEVEL 58
SPLIT FOYER 20
DUPLEX - ALL STYLES AND AGES 52
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 87
1-1/2 STORY PUD - ALL AGES 0
2-STORY PUD - 1946 & NEWER 63
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 10
2 FAMILY CONVERSION - ALL STYLES AND AGES 30

Tenemos una categoria con 0 casos en el Train

Buscamos en el dataset Test

Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 543
1-STORY 1945 & OLDER 70
1-STORY W/FINISHED ATTIC ALL AGES 2
1-1/2 STORY - UNFINISHED ALL AGES 6
1-1/2 STORY FINISHED ALL AGES 143
2-STORY 1946 & NEWER 276
2-STORY 1945 & OLDER 68
2-1/2 STORY ALL AGES 7
SPLIT OR MULTI-LEVEL 60
SPLIT FOYER 28
DUPLEX - ALL STYLES AND AGES 57
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 95
1-1/2 STORY PUD - ALL AGES 1
2-STORY PUD - 1946 & NEWER 65
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 7
2 FAMILY CONVERSION - ALL STYLES AND AGES 31
Id del nivel buscado
    Id
1 2819

Tiene 1 caso, luego no se puede eliminar directamente de todo el conjunto, pero si debemos NO tomarlo en consideracion para la reduccion de variables porque si no trastornaria todos los calculos

Descarto este level para el calculo

Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 536
1-STORY 1945 & OLDER 69
1-STORY W/FINISHED ATTIC ALL AGES 4
1-1/2 STORY - UNFINISHED ALL AGES 12
1-1/2 STORY FINISHED ALL AGES 144
2-STORY 1946 & NEWER 299
2-STORY 1945 & OLDER 60
2-1/2 STORY ALL AGES 16
SPLIT OR MULTI-LEVEL 58
SPLIT FOYER 20
DUPLEX - ALL STYLES AND AGES 52
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 87
2-STORY PUD - 1946 & NEWER 63
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 10
2 FAMILY CONVERSION - ALL STYLES AND AGES 30

Podemos ver que ya no figura

Realizamos la misma operación que con el vecindario, solo que aquí tenemos 16 (15 con la que no tratamos transitoriamente) grupos por lo que los cluster que elegiremos van de 3 a 8

Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES

Dendograma segun medias

Dendograma segun medianas

6. CONCLUSIONES

CRITERIOS

He obtenido en las siguientes tablas los coeficientes de determinación de las variables agrupadas en diferentes clusters.

Tambien figura el valor del que partíamos bajo el epigrafe Todos

La idea es optimizar el numero que nos quedaremos teniendo en cuenta que ya tenemos 11 variables numéricas

Lo primero mas destacable que se observa es que no hay diferencias tomando la media o la mediana de los precios en la variable GarageType.

Esto se explica porque el dendograma es idéntico en ambos supuestos. Aqui se puede ver

Lo segundo que destaca es que en la gran mayoría de los supuestos tomar como referencia la media del precio suele ser mejor que hacerlo con la mediana. La diferencia es positiva en la mayoría de los casos.

Descartamos trabajar con la mediana

Como criterios:

  • En primer lugar seguir el orden asignado por el coeficiente de determinación general. Tendran preferencias las categorías de Neighborhood, sobre el resto, luego Foundation, GarageType y por ultimo MSSubClass

  • Luego elegir aquel agrupamiento en que el paso a un numero de cluster menor suponga una diferencia muy superior a la que supuso el paso anterior (de un numero de clusters mayor). Veremos todo en una tabla con una vista mas amigable

NEIGHBORHOOD (Vecindario)

Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
3 0.510288922673946 0.510288922673946 0
4 0.520752826029343 0.519728064432752 0.00102476159659104
5 0.534661463050312 0.533467614063988 0.00119384898632402
6 0.536798653780542 0.533811092372337 0.002987561408205
7 0.541121980460839 0.539159180649222 0.00196279981161707
8 0.542448822452204 0.54101354304445 0.00143527940775401
Todos 0.545574990809563 0.545574990809563 0

Marco la fila de las casillas de salto mas grandes en amarillo.

Elegir el valor de cluster anterior es una buena forma de comenzar

En este caso son 4 clusters y elegimos 5

FOUNDATION (Cimientos)

Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
2 0.0568254698693131 0.247754678851469 -0.190929208982156
3 0.254395725745173 0.248262307945321 0.00613341779985199
4 0.2548092461983 0.252170668995711 0.00263857720258898
5 0.256199967397587 0.255658927697032 0.000541039700554968
Todos 0.256368401530415 0.256368401530415 0

Descartamos primero aquellas con un coeficiente muy bajo.

Las tacho en naranja. Ese es el minimo

En este caso 2 clusters

Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar

En este caso son 4 clusters y elegimos 5

GARAGETYPE (Ubicacion del garage)

Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
2 0.216280939876281 0.216280939876281 0
3 0.224281569646271 0.224281569646271 0
4 0.247622864331931 0.247622864331931 0
5 0.249122673737389 0.249122673737389 0
Todos 0.249204230504291 0.249204230504291 0

Descartamos primero aquellas con un coeficiente muy bajo.

Las tacho en naranja. Ese es el minimo

En este caso 3 clusters

Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar

En este caso son 3 clusters. El mismo que techamos en naranja. Elegimos 4

MSSubClass (Clase de construccion)

Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
3 0.174786074913226 0.188741697652476 -0.01395562273925
4 0.235584333942853 0.230629760361157 0.00495457358169599
5 0.239410301887266 0.241858637138703 -0.00244833525143701
6 0.243776881430928 0.241878911205326 0.00189797022560198
7 0.245698829986421 0.241915556005449 0.003783273980972
8 0.24576269922555 0.242459440131863 0.00330325909368701
Todos 0.246315972817565 0.246315972817565 0

Descartamos primero aquellas con un coeficiente muy bajo.

Las tacho en naranja. Ese es el minimo

En este caso 3 clusters

Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar

En este caso son 5 clusters. Elegimos 6

PRIMERA CONCLUSION

Tenemos que la primera elección es :

  • Vecinos: 5 clusters sobre 25 categorias Correlacion ~0.7312

  • Cimientos 5 clusters sobre 6 categorias Correlacion ~0.5061

  • Garaje 4 clusters sobre 7 categorias Correlacion~0.4976

  • Clases 6 clusters sobre 16 categorias Correlacion ~0.4937

    Son un total de 20 categorias.

    En las dos ultimas (Garage y Clases ) parece difícil reducir mas sin que haya una perdida importante, y ya están muy al limite.

    Quizas podríamos reducir uno o dos mas en Cimientos, pero la cantidad de 31 variables numéricas , entre las originales y las reconvertidas puede ser una buena cifra

    Para realizar la actualización recuperamos parte del código con el numero cluster que hemos decidido en Neighborhood, Foundation y GarageType.

MODIFICACION EN MSSUBCLASS.


Para el caso de la variable MSSubClass tenemos que recordar que para hacer la agrupación teníamos una categoría que se encontraba en el dataset Test pero no en el Train, luego dejamos esa categoría apartada , pero ahora hay que introducirla manualmente en un cluster.

Para encontrar en que cluster voy a buscar registros con ciertas variables muy correlacionadas con el objetivo y que se parezcan a las del que buscamos.

Voy a usar las variables numéricas Habitat, AreaPiso y OverallQual

Primero identificaremos el registro del Test

Id AreaPiso Habitat OverallQual
2819 0.09323653 0.17182298 0.66666667

A continuacion escogemos las ventanas de los parametros para el filtrado

0.06<AreaPiso<0.12

0.16<Habitat<0.18

0.6<OverallQual<0.7

Filtramos por aproximacion a estas variables

prue<-total%>%filter(OverallQual>0.6 & OverallQual<0.7)%>%select(Id,AreaPiso,Habitat,MSSubClass)
prue<-prue%>%filter(AreaPiso>0.06 & AreaPiso<0.12)
prue<-prue%>%filter(Habitat>0.16 & Habitat<0.18)%>%select(Id,MSSubClass)
Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 0
1-STORY 1945 & OLDER 0
1-STORY W/FINISHED ATTIC ALL AGES 0
1-1/2 STORY - UNFINISHED ALL AGES 0
1-1/2 STORY FINISHED ALL AGES 0
2-STORY 1946 & NEWER 9
2-STORY 1945 & OLDER 0
2-1/2 STORY ALL AGES 0
SPLIT OR MULTI-LEVEL 1
SPLIT FOYER 0
DUPLEX - ALL STYLES AND AGES 0
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 0
1-1/2 STORY PUD - ALL AGES 1
2-STORY PUD - 1946 & NEWER 0
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 0
2 FAMILY CONVERSION - ALL STYLES AND AGES 0

Hay 11 registros con campos parecidos, incluido el que buscamos.

La gran mayoría 9 tienen en MSSubClass-> 2-STORY 1946 & NEWER.

Donde esté esta categoría agrupada pondremos la que nos falta con parte del mismo codigo usado en las variables anteriores

Modificacion especial

Hasta aquí es todo igual en el codigo que en n las variables anteriores.

Vamos a buscar en que grupo queda 2-STORY 1946 & NEWER que es donde hay que meter el nivel de factor que nos falta

train.dat V2
1-STORY 1946 & NEWER ALL STYLES Clase1
1-STORY 1945 & OLDER Clase2
1-STORY W/FINISHED ATTIC ALL AGES Clase3
1-1/2 STORY - UNFINISHED ALL AGES Clase2
1-1/2 STORY FINISHED ALL AGES Clase3
2-STORY 1946 & NEWER Clase4
2-STORY 1945 & OLDER Clase5
2-1/2 STORY ALL AGES Clase1
SPLIT OR MULTI-LEVEL Clase5
SPLIT FOYER Clase3
DUPLEX - ALL STYLES AND AGES Clase6
1-STORY PUD (Planned Unit Development) - 1946 & NEWER Clase1
2-STORY PUD - 1946 & NEWER Clase6
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER Clase2
2 FAMILY CONVERSION - ALL STYLES AND AGES Clase6


Es el elemento numero 6 que corresponde al cluster Clase4

Ademas
levels(total$MSSubClass)
 [1] "1-STORY 1946 & NEWER ALL STYLES"                      
 [2] "1-STORY 1945 & OLDER"                                 
 [3] "1-STORY W/FINISHED ATTIC ALL AGES"                    
 [4] "1-1/2 STORY - UNFINISHED ALL AGES"                    
 [5] "1-1/2 STORY FINISHED ALL AGES"                        
 [6] "2-STORY 1946 & NEWER"                                 
 [7] "2-STORY 1945 & OLDER"                                 
 [8] "2-1/2 STORY ALL AGES"                                 
 [9] "SPLIT OR MULTI-LEVEL"                                 
[10] "SPLIT FOYER"                                          
[11] "DUPLEX - ALL STYLES AND AGES"                         
[12] "1-STORY PUD (Planned Unit Development) - 1946 & NEWER"
[13] "1-1/2 STORY PUD - ALL AGES"                           
[14] "2-STORY PUD - 1946 & NEWER"                           
[15] "PUD - MULTILEVEL - INCL SPLIT LEV/FOYER"              
[16] "2 FAMILY CONVERSION - ALL STYLES AND AGES"            


1-1/2 STORY PUD - ALL AGES tiene que ir en la posicion numero 13.

La añadiremos como una fila a train.dat desplazando el resto
#Añado el level
levels(train.dat$train.dat)<-c(levels(train.dat$train.dat),'1-1/2 STORY PUD - ALL AGES')
#Añado la fila
train.dat<-rbind(train.dat,c('1-1/2 STORY PUD - ALL AGES','Clase4'))
#Cojo levels originales como vector
lev<-as.vector(levels(total$MSSubClass))
#Comparo y ordeno
train.dat<-train.dat[match(lev,train.dat$train.dat),]

#Ya estan ordenados los level y los valores que les sutituyen
levels(TotalFact$MSSubClassMean4)<-train.dat$V2
total$Clases<-TotalFact$MSSubClassMean4



1. INTRODUCCION


Para buscar el modelo que mas conviene tomar para realizar la prediccion que se pide voy a dividir el conjunto de predictores en varias partes.

Por un lado aquellos predictores que son desde el origen numéricos y que además son continuos o discretos con un numero amplio de intervalos

Son :Antiguedad, AntGarage, AreaPiso, GarageTotal, Habitat y OverallQual

En otro grupo los predictores numéricos de origen ordinal con un numero pequeño de intevalos.

Son : BsmtQual, ExterQual, FireplaceQu, GarageFinish y KitchenQual

En el ultimo grupo los predictores de origen categoricos

Son : Neighborhood, Foundation, GarageType y MSSubClass

Esta división solo la hago en sentido grafico para apreciar mejor las diversas características

Voy a aplicar un modelo lineal multiple, uno polinómico, otro suavizado tipo Loess y uno suavizado con curvas Spline y vamos a comparar en cada variable con respecto a la objetivo SalePrice

Aunque el grafico es muy completo entre toda las variables solos nos interesa la fila inferior donde aparecen los graficos de cada predictor en función del objetivo

Podemos ver también en las primeras graficas en la columna mas a la derecha el valor de correlacion de SalePrice con el resto de variables

2. NUMERICAS Continuas

Vision de conjunto 1
Modelo Lineal (lm)-Cyan
Suavizado Local(Loess)-Rojo

Vision de conjunto 2
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja

Vision de conjunto 3
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo

ANTIGUEDAD


Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo

Se adapta mejor la curva suavizada que la recta

ANTIGUEDAD GARAGE (AntGarage)


Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo

La especificidad de los datos (como poner antigüedad a los que no tienen garaje) hace que salga una grafica extraña, pero me decanto por el modelo lineal

AREAPISO


Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo

Los outliers hacen que las curvas no sirvan, pero sin ellos podria ser la opcion adecuada

GARAGETOTAL


Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo

Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion

HABITAT


Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo

Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion

OVERALLQUALL . material general y calidad de acabado


Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo

Pasa algo parecido que con la antigüedad. Se adapta mejor una curva

ANTIGUEDAD: COMPARATIVA DE CURVAS


Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo

Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente

OVERALLQUALL: COMPARATIVA DE CURVAS


Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo

Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente

3. NUMERICAS discretas

Vision de conjunto 1
Regresion: Modelo Lineal (lm)-Cyan
Suavizado Local(Loess)-Rojo


El metodo de regresion local LOESS no es aceptable en estas variables

Vision de conjunto 2
Regresion: B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja

Vision de conjunto 3
Regresion: Modelo lineal con intervalo de confianza - Purpura

BSMTQUAL . Altura del sotano


Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja

Se adapta mejor la curva suavizada que la recta

EXTERQUAL . Calidad del material exterior


Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja

Se adapta mejor la curva suavizada que la recta

FIREPLACEQU . Calidad de la chimenea


Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja

No esta tan claro que tipo se adapta mejor. Se vera numericamente

GARAGEFINISH . Acabado interior del garage


Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja

No esta tan claro que tipo se adapta mejor. Se vera numericamente

KITCHENQUAL . Calidad de la cocina


Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja

Se adapta mejor la curva suavizada que la recta

4. CATEGORICAS

Vision de conjunto 1
Boxplots


En cuanto a las variables categoricas , no se puede hacer ningún análisis grafico de lineas de regresion por la propia composición de la variable.

Si podemos ver una matriz de graficos de sus variables origen ordenadas por la variable destino

Vision de conjunto 2
Nubes de puntos

Neighborhood . Vecindario


Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad

Foundation . Cimientos


Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad

GarageType . Ubicacion del garage


Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad

MSSubClass . Clase de construccion


Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad

Vemos ahora con la agrupación de clusters y ordenadas

Neighborhood . Vecindario
5 clusters


Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias

Foundation . Cimientos
5 clusters


Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
Es posible eliminar un cluster mas en Cimientos como se había apuntado, pero ahora se ve mejor

GarageType . Ubicacion del garage
4 clusters


Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias

MSSubClass . Clase de construccion
6 clusters


Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias

Foundation
Resultados para 3, 4 y 5 clusters

Foundation . Cimientos
5 clusters

Foundation . Cimientos
4 clusters

Foundation . Cimientos
3 clusters

Conclusion

Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
2 0.0568254698693131 0.247754678851469 -0.190929208982156
3 0.254395725745173 0.248262307945321 0.00613341779985199
4 0.2548092461983 0.252170668995711 0.00263857720258898
5 0.256199967397587 0.255658927697032 0.000541039700554968
Todos 0.256368401530415 0.256368401530415 0

Graficamente la mejor opcion es n=3.

Ademas vimos en la sección anterior que no había tanta diferencia

Transformación de las categorías de las variables no numéricas en variables dummy

#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact1<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact1$Id<-total$Id

#Conversion a Dummys
Total.dummy.B<-TotalFact1%>%select(Id,B=Vecindario)
Total.dummy.C<-TotalFact1%>%select(Id,C=Cimientos)
Total.dummy.G<-TotalFact1%>%select(Id,G=UbicaGarage)
Total.dummy.N<-TotalFact1%>%select(Id,N=Clases)

modelo1.B<-as.data.frame(model.matrix(~.,Total.dummy.B))
modelo1.C<-as.data.frame(model.matrix(~.,Total.dummy.C))
modelo1.G<-as.data.frame(model.matrix(~.,Total.dummy.G))
modelo1.N<-as.data.frame(model.matrix(~.,Total.dummy.N))
modelo1.B$`(Intercept)`<-NULL
modelo1.C$`(Intercept)`<-NULL
modelo1.G$`(Intercept)`<-NULL
modelo1.N$`(Intercept)`<-NULL

modelo1<-modelo1.B
modelo1<-cbind(modelo1,modelo1.C%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.G%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.N%>%select(-Id))

#Modelo con dummys
Cuant<-total%>%select(Antiguedad,AntGarage,AreaPiso,BsmtQual,ExterQual,FireplaceQu,GarageFinish,GarageTotal,Habitat,KitchenQual,OverallQual,SalePrice)
modelo1.dummy<-cbind(modelo1,Cuant)

#Modelo con variables categoricas
Total.dummy<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases)
modelo1.Nodummy<-cbind(Total.dummy,Cuant)


5. OUTLIERS

VALORES YA REVISADOS


Si recordamos encontramos dos valores outliers .

El registro 524 que tenia discordancia entre los años de construcción, remodelación y venta (corregido) y además tenia un precio muy bajo para el área habitable en sotano y primer piso.

Eso mismo le pasaba al registro 1299 que tenia un precio muy bajo para el área habitable y además no tenia proporción entre el área habitable, las habitaciones y los baños

En principio tenia pensado dejarles por que además en común con estos dos teniamos el registro 2550 que tenia discordancia en los años y falta de proporción entre el área habitable, las habitaciones y los baños, y este registro esta en el Test, pero he creido mas conveniente eliminarles de los datos

Antes de eliminarlos vamos a comprobar que posición ocupan en las variables numéricas normalizadas porque si son el valor extremo, máximo o minimo , al eliminarlo deberemos volver a normalizar esa variable con el nuevo extremo

COMPROBACION Y NORMALIZACION

Id Antiguedad AntGarage AreaPiso GarageTotal Habitat OverallQual
524 0 0 0.5676347 0.35645161 0.75770895 1
Id Antiguedad AntGarage AreaPiso GarageTotal Habitat OverallQual
1299 0 0 1 0.3811828 0.91658963 1
#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=524)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1299)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)

modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=524)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1299)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)

modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)

Tanto Antigüedad como AntGarage ,y OverallQuall tienen varios registros con el mismo valor que el que vamos a eliminar, .

Sin embargo en AreaPiso el registro 1299 es el máximo. Cuando le eliminemos hay que normalizar de nuevo

Realizaremos una comprobacion grafica de las variables mas afectadas por los outliers que vimos en la seccion anterior

Afectaban sobre todo a AreaPiso, GarageTotal y Habitat.

AreaPiso antes


Con los outliers que distorsionaban la curva

AreaPiso despues


Han mejorado

GarageTotal antes


Con los outliers que distorsionaban la curva

GarageTotal despues


Tenemos otros outliers que aparecen en GarageTotal

Habitat antes


Con los outliers que distorsionaban la curva

Habitat despues


Han mejorado

Seleccionamos los outliers que aparecian en GarageTotal y vemos su influencia en AreaPiso (puntos en rojo)


No tienen una gran influencia, ni su mantenimiento, ni su eliminacion

Seleccionamos los outliers que aparecian en GarageTotal y vemos su influencia en Habitat (puntos en rojo)


No tienen una gran influencia, ni su mantenimiento, ni su eliminacion

Los eliminamos, actualizamos, normalizamos y volvemos a revisar los graficos

Id
582
1062
1191
1351
#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=582)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1062)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1191)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1351)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)

modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=582)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1062)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1191)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1351)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)

modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)

Volvemos a cargar los graficos y comparamos

AreaPiso antes segundos outliers

AreaPiso despues segundos outliers

GarageTotal antes segundos outliers


Con los outliers que distorsionaban la curva

GarageTotal despues segundos outliers


Vemos como ha mejorado bastante

Habitat antes segundos outliers

Habitat despues segundos outliers

1. FILTRADO


Vamos a realizar un filtrado de las variables mediante el método sbf() del paquete caret

Vamos a realizarlo con dos funciones internas diferentes para poder comparar y validar los resultados , ramdom forest y modelo lineal

#FILTRADO DE VARIABLES CON CARET
#Filtrado con sbf de caret usando RandomForest y Linear Model

# Se crea una semilla para cada partición y cada repetición: el vector debe 
# tener B+1 semillas donde B = particiones * repeticiones.

ModeloTrain.Nodummy<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
set.seed(456)
particiones = 10 
repeticiones = 5
seeds <- sample.int(1000, particiones * repeticiones + 1)

# Control del filtrado Random Forest
ctrl_filtrado.rf <- sbfControl(functions = rfSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)

# Control del filtrado Linear Model
ctrl_filtrado.lm <- sbfControl(functions = lmSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)

set.seed(234) 
rf_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.rf,ntree = 500) 

lm_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.lm) 

Podemos apreciar que los resultados son iguales

De las 25 variables solo se ha descartado 1 Clase5. Las que quedan aparecen en las tablas inferiores para los distintos modelos

Aplicamos los resultado y eliminamos variable no influyente


RANDOM FOREST
x
VecindarioBarrio2
VecindarioBarrio3
VecindarioBarrio4
VecindarioBarrio5
CimientosCimientos2
CimientosCimientos3
UbicaGarageGarage2
UbicaGarageGarage3
UbicaGarageGarage4
ClasesClase2
ClasesClase3
ClasesClase4
ClasesClase6
Antiguedad
AntGarage
AreaPiso
BsmtQual
ExterQual
FireplaceQu
GarageFinish
GarageTotal
Habitat
KitchenQual
OverallQual
MODELO LINEAL
x
VecindarioBarrio2
VecindarioBarrio3
VecindarioBarrio4
VecindarioBarrio5
CimientosCimientos2
CimientosCimientos3
UbicaGarageGarage2
UbicaGarageGarage3
UbicaGarageGarage4
ClasesClase2
ClasesClase3
ClasesClase4
ClasesClase6
Antiguedad
AntGarage
AreaPiso
BsmtQual
ExterQual
FireplaceQu
GarageFinish
GarageTotal
Habitat
KitchenQual
OverallQual


2. MODELADO

Antes de empezar a aplicar modelos tenemos que eliminar la variable Id de ambos dataset, pero guardando una copia para poder enviar la respuesta

Para la fijación de nuestro modelo vamos a elegir el método de la validación cruzada del dataset Train con 20 iteraciones

No sabiendo que modelo elegir, para lo cual probaremos con el método train() del paquete caret diversos modelos y veremos que resultados nos aportan

Una cosa interesante que aporta este metodo es que llama a los diversos metodos de distintos paquetes con diferentes hiperparametros y se encarga de seleccionar los parametros propios de cada metodo mas eficientes

#PRUEBAS MODELOS
set.seed(234)

#MultiVariate Adaptative Regression Splines
MARS<-train(TrainFinal[,-25],TrainFinal[,25],'gcvEarth',trControl = trainControl(method = 'cv',number = 20))

#Modelo lineal
LM<-train(TrainFinal[,-25],TrainFinal[,25],'lm',trControl = trainControl(method = 'cv',number = 20))

#Ramdom Forest
RF<-train(TrainFinal[,-25],TrainFinal[,25],'ranger',trControl = trainControl(method = 'cv',number = 20))         

#Modelo lineal
rlm<-lm(formula = SalePrice~.,data=TrainFinal)

#Regression splines
rnd<-lm(formula=SalePrice~bs(Antiguedad)+bs(OverallQual)+bs(BsmtQual)+bs(ExterQual)+bs(FireplaceQu)+bs(GarageFinish)+bs(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)

#Natural splines
rnd2<-lm(formula=SalePrice~ns(Antiguedad)+ns(OverallQual)+ns(BsmtQual)+ns(ExterQual)+ns(FireplaceQu)+ns(GarageFinish)+ns(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)

#Generalized Additice Model using SPLINE
GAMS<-train(TrainFinal[,-25],TrainFinal[,25],'gamSpline',trControl = trainControl(method = 'cv',number = 20))

#Generalize Linear Models
GLM<-train(TrainFinal[,-25],TrainFinal[,25],'glm',trControl = trainControl(method = 'cv',number = 20))

#Bayesian Ridge Regression
BRR<-train(TrainFinal[,-25],TrainFinal[,25],'bridge',trControl = trainControl(method = 'cv',number = 20))

#Bayesian Ridge Regression (Model Averaged)
BLASSO<-train(TrainFinal[,-25],TrainFinal[,25],'blassoAveraged',trControl = trainControl(method = 'cv',number = 20))

#Extreme gradient boosting
XGB<-train(TrainFinal[,-25],TrainFinal[,25],'xgbLinear',trControl = trainControl(method = 'cv',number = 20))

XGBT<-train(TrainFinal[,-25],TrainFinal[,25],'xgbTree',trControl = trainControl(method = 'cv',number = 20))

3. RESULTADOS

Vamos a comparar los modelos elegidos

#Comprobacion resultados
options(digits=6)
model<-list(gcvEarth=MARS,lm=LM,ranger=RF,gamSpline=GAMS,glm=GLM,bridge=BRR,blassoAveraged=BLASSO,xgbLinear=XGB,xgbTree=XGBT)
result.resamples<-resamples(model)
#Resutados
metricas_resamples <- result.resamples$values%>%gather(key = "modelo", value = "valor", -Resample)%>%separate(col = "modelo", into = c("modelo", "metrica"), sep = "~", remove = TRUE)
modelo MAE RMSE Rsquared
xgbTree 17900.3 25888.2 0.891002
ranger 17796.4 26444.9 0.890143
gcvEarth 18527.0 26813.4 0.882849
gamSpline 19205.6 27160.8 0.882141
xgbLinear 19324.2 27388.8 0.881359
bridge 20573.4 29588.9 0.864643
blassoAveraged 20444.0 29604.4 0.864640
lm 20440.4 29307.8 0.863801
glm 20408.2 29537.1 0.862450

  • MAE: Mean Absolute Error. Media de errores absolutos

  • RMSE: Root Mean Squared Error. Raiz cuadradra de la media de los residuos al cuadrado.

  • RSquared: Bondad del ajuste. Es la relacion entre la suma de los cuadrados de regresion y la suma total de cuadrados.

Aunque el uso de un tipo de indicador u otro favorece ciertas caracteristicas en cada modelo, parece claro que hay dos que estan por encima de los demas en todos los indicadores

Resultados de los modelos con los distintos criterios. (La escala X esta recortada para mejor visualizacion) .

Modelos ordenados por Rsquared.


Los modelos que parecen mas efectivos son RandomForest, y xgbTree

  • ranger: RandomForest es un ensamble en paralelo (bagging) de arboles de predicción en los que se selecciona aleatoriamente los predictores en cada nodo

  • xgbTree: eXtreme Gradient Boosting es un ensamble secuencial (boosting) de arboles de predicción en el que cada árbol intenta minimizar los residuos del anterior

Los otros modelos que también dan buenos resultados son:

  • GAMSpline :Generalized Additive Model using Splines es una combinacion lineal de funciones no lineales.Se trata de combinar distintos tipos de regresión en un conjunto no lineal, usando aquí smooth Splines

  • gvcEarth: MultiVariate Adaptative Regression Splines es parecido al anterior pero usando regression splines

  • XGBLinear es un un ensamble secuencial como XGBoost pero orientado hacia el modelo lineal

4. PREDICCION

En un data frame elijo en varias columnas las predicciones que me da cada modelo

#Calculos previos para ponderaciones
RS<-metricas_resamples%>%filter(metrica=="Rsquared") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared))
RSM<-metricas_resamples%>%filter(metrica=="MAE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(MAE))
RSE<-metricas_resamples%>%filter(metrica=="RMSE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(RMSE))
RST<-RS%>%spread(modelo,Rsquared)
RSMT<-RSM%>%spread(modelo,MAE)
RSET<-RSE%>%spread(modelo,RMSE)

#Calculo para distintas ponderaciones
SumaRs<-RST$ranger+RST$gamSpline+RST$xgbTree+RST$gcvEarth+RST$xgbLinear
SumaRSM<-((1/RSMT$ranger)+(1/RSMT$gamSpline)+(1/RSMT$xgbTree)+(1/RSMT$gcvEarth)+(1/RSMT$xgbLinear))
SumaRSE<-((1/RSET$ranger)+(1/RSET$gamSpline)+(1/RSET$xgbTree)+(1/RSET$gcvEarth)+(1/RSET$xgbLinear))

#Prediccion
result<-CopiaTest%>%select(-SalePrice)
result$RF<-predict(RF,TestFinal)
result$GAM<-predict(GAMS,TestFinal)
result$XGBT<-predict(XGBT,TestFinal)
result$MARS <-predict(MARS,TestFinal)
result$XGB <-predict(XGB,TestFinal)
result$media<-round(((result$RF+result$GAM+result$XGBT+result$MARS+result$XGB)/5),digits = 1)
#ponderada sobre Rsquared
result$ponderada<-round((((result$RF*RST$ranger)+(result$GAM*RST$gamSpline)+(result$XGBT*RST$xgbTree)+(result$MARS*RST$gcvEarth)+(result$XGB*RST$xgbLinear))/SumaRs),digits = 1)
#Ponderada sobre MAE
result$ponderada1<-round((((result$RF/RSMT$ranger)+(result$GAM/RSMT$gamSpline)+(result$XGBT/RSMT$xgbTree)+(result$MARS/RSMT$gcvEarth)+(result$XGB/RSMT$xgbLinear))/SumaRSM),digits = 1)
#Ponderada sobre RMSE
result$ponderada2<-round((((result$RF/RSET$ranger)+(result$GAM/RSET$gamSpline)+(result$XGBT/RSET$xgbTree)+(result$MARS/RSET$gcvEarth)+(result$XGB/RSET$xgbLinear))/SumaRSE),digits = 1)

#Redondeo hacia arriba en centenas de los valores
result$RF<-100*ceiling((result$RF/100))
result$GAM<-100*ceiling((result$GAM/100))
result$XGBT<-100*ceiling((result$XGBT/100))
result$MARS<-100*ceiling((result$MARS/100))
result$XGB<-100*ceiling((result$XGB/100))
result$media<-100*ceiling((result$media/100))
result$ponderada<-100*ceiling((result$ponderada/100))
result$ponderada1<-100*ceiling((result$ponderada1/100))
result$ponderada2<-100*ceiling((result$ponderada2/100))
Fin<-result%>%select(Id,SalePrice=media)
Fin1<-result%>%select(Id,SalePrice=RF)
Fin2<-result%>%select(Id,SalePrice=GAM)
Fin3<-result%>%select(Id,SalePrice=XGBT)
Fin4<-result%>%select(Id,SalePrice=MARS)
Fin5<-result%>%select(Id,SalePrice=XGB)
Fin6<-result%>%select(Id,SalePrice=ponderada)
Fin7<-result%>%select(Id,SalePrice=ponderada1)
Fin8<-result%>%select(Id,SalePrice=ponderada2)

write.csv(Fin,file="Ames2_house.csv",row.names = FALSE)
write.csv(Fin1,file="Ames2_house1.csv",row.names = FALSE)
write.csv(Fin2,file="Ames2_house2.csv",row.names = FALSE)
write.csv(Fin3,file="Ames2_house3.csv",row.names = FALSE)
write.csv(Fin4,file="Ames2_house4.csv",row.names = FALSE)
write.csv(Fin5,file="Ames2_house5.csv",row.names = FALSE)
write.csv(Fin6,file="Ames2_house6.csv",row.names = FALSE)
write.csv(Fin7,file="Ames2_house7.csv",row.names = FALSE)
write.csv(Fin8,file="Ames2_house8.csv",row.names = FALSE)

5. TEST

Estos son los resultado en KAGGLE

El valor corresponde al resultado aplicado al TEST que nos da RMSLE: Root Mean Squared Logarithmic Error   similar al RMSE pero aplicando una reduccion logaritmica previa a los datos

Column

Podemos apreciar que los valores son muy parecidos tanto en la media directa de los modelos escogidos como en aquella ponderacion con el criterio que sea


Medias y Ponderadas

Column

Aunque se mantiene el orden de eficiencia que habiamos obtenido de los modelos durante el entrenamiento , hay que destacar que cualquier mezcla de varios sea con el criterio que sea de ponderacion es mejor que el mejor de los modelos en solitario

Modelos

---
title: "TFM"
output: 
  flexdashboard::flex_dashboard:
    theme: united 
    highlight: haddock 
    source_code: embed

---


```{r setup, include=FALSE, message=FALSE,warning=FALSE}
library(flexdashboard)
library(dplyr)
library(kableExtra)
library(ggplot2)
library(knitr)
library(corrplot)
library(FactoMineR)
library(GGally)
library(ggdendro)
library(caret)
library(splines)
library(tidyr)

options(knitr.table.format = "html")

#Funciones para los graficos
give.n <- function(x,n){
  return(c(y = mean(x)*1.5, label = length(x)))
}
give1.n<-function(x,n){
  return(c(y = mean(x)*1.5, label = length(x)))
}

my_rg1 <- function(data, mapping, ...){
  
  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() +
    geom_smooth(method='loess', fill="red", color="red",se=FALSE) +
    geom_smooth(method='lm', fill="cyan", color="cyan",se=FALSE) 
    
  p
  
}
my_rg2 <- function(data, mapping, ...){
  
  p <- ggplot(data = data,mapping=mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkorchid3',color='darkorchid3',se=FALSE) +
    
    geom_smooth(method='lm',formula=y~poly(x),fill='orangered',color='orangered',se=FALSE)
  
  p
  
}
my_rg3 <- function(data, mapping, ...){
 
  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkgreen',color='darkgreen',alpha=.1) +
    
    geom_smooth(method='loess', fill="firebrick1", color="firebrick1",alpha=.1)
  
  p
  
}
#Solo para las discretas
my_rg4 <- function(data, mapping, ...){

  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',fill='purple',color='purple',alpha=.3)
  
  p
  
}

#Funcion para regresion
normalize <- function(x) {
  return ((x - min(x)) / (max(x) - min(x))) }

```

0 PORTADA {.hidden}
======
**TRABAJO FIN MASTER** **Big Data y Business Analytics**

**Precios de las vivendas en Ames, IOWA US**


**Victor M. del Canto Godino**
**20 de Septiembre de 2018**

Agradecimientos:

A Erik Bruin y Tanner Carbonati por sus kernels en Kaggle que me ayudaron a decidirme sobre qué hacer y sobre todo , qué no hacer.

A Joaquin Amat Rodrigo por sus explicaciones sobre estadística en Github y Rpubs

1 ESTRUCTURA DE LOS DATOS {vertical_layout=scroll data-navmenu="1 PREPARACION"} ========= Column {data-width=350} ----------------------------------------------------------------------- Tenemos un archivo de entrenamiento para realizar un aprendizaje supervisado formado por 1460 casos con 81 variables.
Una de ellas es nuestro objetivo `SalePrice`, y debemos ser capaces de predecir esa variable con el dataframe `Test` que se nos proporciona, que es de 1459 casos. Otra variable importante es la primera `Id` que nos identifica de manera única cada registro.
En el dataframe `Train` tenemos los 1460 primeros. En el dataframe `Test` tenemos desde el 1461 hasta el 2919 Tenemos varios tipos de variables, como se vera en el siguiente epígrafe, además de las cuales cambiaremos los tipos de algunas.
Hay que realizar una limpieza y control exhaustiva de todos los datos, haciendo énfasis en los valores **NA**
Para realizar una preparación adecuada y buscar un modelo hay que unir los dos dataframe creando los datos que nos faltan en `Test` (`SalePrice` la variable objetivo ) y poniendo como valor **NA** ```{r} ``` Column {vertical_layout=scroll data-width=600} ----------------------------------------------------------------------- ```{r} url_test="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/test.csv" url_train="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/train.csv" train<-read.csv("train.csv",sep = ",", header=TRUE,stringsAsFactors = FALSE) test<-read.csv("test.csv",sep=",",header=TRUE,stringsAsFactors = FALSE) ```

Sumario, estructura de los dataset y dimensiones

```{r collapse=TRUE,size=8} summary(train) ``` ```{r collapse=TRUE} str(train) ``` ```{r collapse=TRUE} dim(train) ``` ```{r} AuxTrain<-train AuxTest<-test AuxTest$SalePrice<-NA total<-rbind(AuxTrain,AuxTest) ``` 2 VARIABLES {data-orientation=rows data-navmenu="1 PREPARACION"} ======== Row {data-height=60} --------------- ### ESTE TIPO DE VARIABLES SON **CUANTIFICABLES**.    PINCHE EL TIPO AL QUE QUIERE DIRIGIRSE     Variables [cuantificables](#variables).   Variables [categoricas](#categoricas) .   Variables [cuantificadas](#cuantificadas) Row {vertical_layout=fill} ------------- ### .
Codigo | Significado --------------|--------------------------------------------------- ID | Identidad LotFrontage | pies lineales de la calle conectados a la propiedad LotArea | Tamaño del lote en pies cuadrados YearBuilt | fecha de construcción original YearRemodAdd | fecha de remodelación MasVnrArea | área de chapa de la albañilería en pies cuadrados BsmtFinSF1 | Tipo 1 pies cuadrados terminados BsmtFinSF2 | Tipo 2 pies cuadrados terminados BsmtUnfSF | Pies cuadrados sin terminar del área del sótano TotalBsmtSF | pies cuadrados totales del área del sótano 1stFlrSF | primer piso pies cuadrados 2ndFlrSF | segundo piso pies cuadrados LowQualFinSF | Pies cuadrados terminados de baja calidad (todos los pisos) GrLivArea | pies cuadrados del área habitable sobre el nivel del suelo BsmtFullBath | baños completos en el sótano BsmtHalfBath | medio baño en el sótano FullBath | baños completos por encima del grado HalfBath | medio baño por encima del grado
### .
Codigo | Significado --------------|--------------------------------------------------- Bedroom | Número de habitaciones sobre el nivel del sótano Kitchen | Número de cocinas TotRmsAbvGrd | Total de habitaciones por encima del grado (no incluye baños) Fireplaces | cantidad de chimeneas GarageYrBlt | año de garaje fue construido GarageCars | tamaño del garaje en la capacidad del automóvil GarageArea | Tamaño del garaje en pies cuadrados WoodDeckSF | área de cubierta de madera en pies cuadrados OpenPorchSF | área de porche abierto en pies cuadrados EnclosedPorch | área de porche cerrado en pies cuadrados 3SsnPorch | área del porche de tres estaciones en pies cuadrados ScreenPorch | área del porche de la pantalla en pies cuadrados PoolArea | área de la piscina en pies cuadrados MiscVal | $ Valor de la función miscelánea MoSold | Mes vendido YrSold | Año de venta SalePrice | el precio de venta de la propiedad en dólares.
CATEGORICAS {data-orientation=rows .hidden} ====== Row {data-height=80} --------------- ### ESTE TIPO DE VARIABLES SON **CATEGORICAS**    PINCHE EL TIPO AL QUE QUIERE DIRIGIRSE   Variables [cuantificables](#variables).   Variables [categoricas](#categoricas) .   Variables [cuantificadas](#cuantificadas) Row {vertical_layout=scroll} ------------ ### .
> MSZoning *** > la clasificación general de zonificación *** Codigo | Tipo -------------------- | -------------------- A | Agriculture C | Commercial FV | Floating Village Residential I | Industrial RH | Residential High Density RL | Residential Low Density RP | Residential Low Density Park RM | Residential Medium Density *** > Street *** > Tipo de acceso por carretera *** Codigo | Tipo -------------------- | -------------------- Grvl | Gravel Pave | Paved *** > Alley *** > tipo de acceso a callejones *** Codigo | Tipo -------------------- | -------------------- Grvl | Gravel Pave | Paved NA | No alley access *** > LotShape *** > forma general de la propiedad *** Codigo | Tipo -------------------- | -------------------- Reg | Regular IR1 | Slightly irregular IR2 | Moderately Irregular IR3 | Irregular *** > LandContour *** > planitud de la propiedad *** Codigo | Tipo -------------------- | -------------------- Lvl | Near Flat/Level Bnk | Banked - Quick and significant rise from street grade to building HLS | Hillside - Significant slope from side to side Low | Depression *** > Utilities *** > Tipo de utilidades disponibles *** Codigo | Tipo -------------------- | -------------------- AllPub | All public Utilities (E,G,W,& S) NoSewr | Electricity, Gas, and Water (Septic Tank) NoSewa | Electricity and Gas Only ELO | Electricity only *** > LotConfig *** > configuración del lote *** Codigo | Tipo -------------------- | -------------------- Inside | Inside lot Corner | Corner lot CulDSac | Cul-de-sac FR2 | Frontage on 2 sides of property FR3 | Frontage on 3 sides of property *** > LandSlope *** > Pendiente de la propiedad *** Codigo | Tipo -------------------- | -------------------- Gtl | Gentle slope Mod | Moderate Slope Sev | Severe Slope *** > Neighborhood *** > ubicaciones físicas dentro de los límites de la ciudad de Ames *** Codigo | Tipo -------------------- | -------------------- Blmngtn | Bloomington Heights Blueste | Bluestem BrDale | Briardale BrkSide | Brookside ClearCr | Clear Creek CollgCr | College Creek Crawfor | Crawford Edwards | Edwards Gilbert | Gilbert IDOTRR | Iowa DOT and Rail Road MeadowV | Meadow Village Mitchel | Mitchell NAmes | North Ames NoRidge | Northridge NPkVill | Northpark Villa NridgHt | Northridge Heights NWAmes | Northwest Ames OldTown | Old Town SWISU | South & West of Iowa State University Sawyer | Sawyer SawyerW | Sawyer West Somerst | Somerset StoneBr | Stone Brook Timber | Timberland Veenker | Veenker *** > Condition1 *** > proximidad a la carretera principal o ferrocarril *** Codigo | Tipo -------------------- | -------------------- Artery | Adjacent to arterial street Feedr | Adjacent to feeder street Norm | Normal PosA | Adjacent to postive off-site feature PosN | Near positive off-site feature--park, greenbelt, etc. RRAe | Adjacent to East-West Railroad RRAn | Adjacent to North-South Railroad RRNe | Within 200' of East-West Railroad RRNn | Within 200' of North-South Railroad *** > Condition2 *** > proximidad a la carretera principal o ferrocarril (si hay un segundo presente) *** Codigo | Tipo -------------------- | -------------------- Artery | Adjacent to arterial street Feedr | Adjacent to feeder street Norm | Normal PosA | Adjacent to postive off-site feature PosN | Near positive off-site feature--park, greenbelt, etc. RRAe | Adjacent to East-West Railroad RRAn | Adjacent to North-South Railroad RRNe | Within 200' of East-West Railroad RRNn | Within 200' of North-South Railroad *** > BldgType *** > tipo de vivienda *** Codigo | Tipo -------------------- | -------------------- 1Fam | Single-family Detached 2fmCon | Two-family Conversion; originally built as one-family dwelling Duplex | Duplex TwnhsE | Townhouse End Unit Twnhs | I Townhouse Inside Unit *** > HouseStyle *** > estilo de vivienda *** Codigo | Tipo -------------------- | -------------------- 1.5Fin | One and one-half story: 2nd level finished 1.5Unf | One and one-half story: 2nd level unfinished 1Story | One story 2.5Fin | Two and one-half story: 2nd level finished 2.5Unf | Two and one-half story: 2nd level unfinished 2Story | Two story SFoyer | Split Foyer SLvl | Split Level *** > RoofStyle *** > tipo de techo *** Codigo | Tipo -------------------- | -------------------- Flat | Flat Gable | Gable Gambrel | Gabrel (Barn) Hip | Hip Mansard | Mansard Shed | Shed *** > RoofMatl *** > material de techo *** Codigo | Tipo -------------------- | -------------------- ClyTile | Clay or Tile CompShg | Standard (Composite) Shingle Membran | Membrane Metal | Metal Roll | Roll Tar&Grv | Gravel & Tar WdShake | Wood Shakes WdShngl | Wood Shingles
*** ### .
> Exterior1st *** > revestimiento exterior en la casa *** Codigo | Tipo -------------------- | -------------------- AsbShng | Asbestos Shingles AsphShn | Asphalt Shingles BrkComm | Brick Common BrkFace | Brick Face CBlock | Cinder Block CemntBd | Cement Board HdBoard | Hard Board ImStucc | Imitation Stucco MetalSd | Metal Siding Other | Other Plywood | Plywood PreCast | PreCast Stone | Stone Stucco | Stucco VinylSd | Vinyl Siding Wd Sdng | Wood Siding WdShing | Wood Shingles *** > Exterior2nd *** > Cubierta exterior en la casa (si hay más de un material) *** Codigo | Tipo -------------------- | -------------------- AsbShng | Asbestos Shingles AsphShn | Asphalt Shingles Brk Cmn | Brick Common BrkFace | Brick Face CBlock | Cinder Block CmentBd | Cement Board HdBoard | Hard Board ImStucc | Imitation Stucco MetalSd | Metal Siding Other | Other Plywood | Plywood PreCast | PreCast Stone | Stone Stucco | Stucco VinylSd | Vinyl Siding Wd Sdng | Wood Siding Wd Shng | Wood Shingles *** > MasVnrType *** > Tipo de chapa de mampostería *** Codigo | Tipo -------------------- | -------------------- BrkCmn | Brick Common BrkFace | Brick Face Cblock | Cinder Block None | None Stone | Stone *** > ExterQual *** > calidad del material exterior *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair Gd | Good TA | Average/Typical Po | Poor *** > ExterCond *** > estado actual del material en el exterior *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair Gd | Good Po | Poor TA | Average/Typical *** > Foundation *** > tipo de fundación *** Codigo | Tipo -------------------- | -------------------- BrkTil | Brick & Tile CBlock | Cinder Block PConc | Poured Contrete Slab | Slab Stone | Stone Wood | Wood *** > BsmtQual *** > Altura del sótano *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent (100+ inches) Fa | Fair (70-79 inches) Gd | Good (90-99 inches) **NA** | No Basement Po | Poor (<70 inches TA | Typical (80-89 inches) *** > BsmtCond *** > estado general del sótano *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair - dampness or some cracking or settling Gd | Good **NA** | No Basement Po | Poor - Severe cracking, settling, or wetness TA | Typical - slight dampness allowed *** > BsmtExposure *** > muros de sotano a ras de suelo o de jardín *** Codigo | Tipo -------------------- | -------------------- Av | Average Exposure (split levels or foyers typically score average or above) Gd | Good Exposure Mn | Mimimum Exposure **NA** | No Basement No | No Exposure *** > BsmtFinType1 *** > Calidad del área acabada del sótano *** Codigo | Tipo -------------------- | -------------------- ALQ | Average Living Quarters BLQ | Below Average Living Quarters GLQ | Good Living Quarters LwQ | Low Quality **NA** | No Basement Rec | Average Rec Room Unf | Unfinshed *** > BsmtFinType2 *** > Calidad del segundo área terminada (si está presente) *** Codigo | Tipo -------------------- | -------------------- ALQ | Average Living Quarters BLQ | Below Average Living Quarters GLQ | Good Living Quarters LwQ | Low Quality **NA** | No Basement Rec | Average Rec Room Unf | Unfinshed
### .
> Heating *** > tipo de calefacción *** Codigo | Tipo -------------------- | -------------------- Floor | Floor Furnace GasA | Gas forced warm air furnace GasW | Gas hot water or steam heat Grav | Gravity furnace OthW | Hot water or steam heat other than gas Wall | Wall furnace *** > HeatingQC *** > Calidad y condición de la calefacción *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair Gd | Good Po | Poor TA | Average/Typical *** > CentralAir *** > Aire acondicionado central *** Codigo | Tipo -------------------- | -------------------- N | No Y | Yes *** > Electrical *** > sistema eléctrico *** Codigo | Tipo -------------------- | -------------------- FuseA | Fuse Box over 60 AMP and all Romex wiring (Average) FuseF | 60 AMP Fuse Box and mostly Romex wiring (Fair) FuseP | 60 AMP Fuse Box and mostly knob & tube wiring (poor) Mix | Mixed SBrkr | Standard Circuit Breakers & Romex *** > KitchenQual *** > calidad de la cocina *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair Gd | Good Po | Poor TA | Typical/Average *** > Functional *** > calificación de la funcionalidad del hogar *** Codigo | Tipo -------------------- | -------------------- Maj1 | Major Deductions 1 Maj2 | Major Deductions 2 Min1 | Minor Deductions 1 Min2 | Minor Deductions 2 Mod | Moderate Deductions Sal | Salvage only Sev | Severely Damaged Typ | Typical Functionality *** > FireplaceQu *** > calidad de la chimenea *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent - Exceptional Masonry Fireplace Fa | Fair - Prefabricated Fireplace in basement Gd | Good - Masonry Fireplace in main level **NA** | No Fireplace Po | Poor - Ben Franklin Stove TA | Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement *** > GarageType *** > ubicación del garaje *** Codigo | Tipo -------------------- | -------------------- 2Types | More than one type of garage Attchd | Attached to home Basment | Basement Garage BuiltIn | Built-In (Garage part of house - typically has room above garage) CarPort | Car Port Detchd | Detached from home **NA** | No Garage *** > GarageFinish *** > acabado interior del garaje *** Codigo | Tipo -------------------- | -------------------- Fin | Finished RFn | Rough Finished Unf | Unfinished **NA** | No Garage *** > GarageQual *** > calidad de garaje *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair Gd | Good **NA** | No Garage Po | Poor TA | Typical/Average *** > GarageCond *** > condición de garaje *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair Gd | Good **NA** | No Garage Po | Poor TA | Typical/Average *** > PavedDrive *** > calzada pavimentada *** Codigo | Tipo -------------------- | -------------------- N | Dirt/Gravel P | Partial Pavement Y | Paved *** > PoolQC *** > calidad de la piscina *** Codigo | Tipo -------------------- | -------------------- Ex | Excellent Fa | Fair Gd | Good **NA** | No Pool TA | Average/Typical *** > Fence *** > calidad de la cerca *** Codigo | Tipo -------------------- | -------------------- GdPrv | Good Privacy GdWo | Good Wood MnPrv | Minimum Privacy MnWw | Minimum Wood/Wire **NA** | No Fence *** > MiscFeature *** > característica miscelánea no cubierta en otras categorías *** Codigo | Tipo -------------------- | -------------------- Elev | Elevator Gar2 | 2nd Garage (if not described in garage section) **NA** | None Othr | Other Shed | Shed (over 100 SF) TenC | Tennis Court *** > SaleType *** > Tipo de venta *** Codigo | Tipo -------------------- | -------------------- COD | Court Officer Deed/Estate Con | Contract 15% Down payment regular terms ConLD | Contract Low Down ConLI | Contract Low Interest ConLw | Contract Low Down payment and low interest CWD | Warranty Deed - Cash New | Home just constructed and sold Oth | Other VWD | Warranty Deed - VA Loan WD | Warranty Deed - Conventional *** > SaleCondition *** > Condiciones de venta *** Codigo | Tipo -------------------- | -------------------- Abnorml | Abnormal Sale - trade, foreclosure, short sale AdjLand | Adjoining Land Purchase Alloca | Allocation - two linked properties with separate deeds, typically condo with a garage unit Family | Sale between family members Normal | Normal Sale Partial | Home was not completed when last assessed (associated with New Homes)
CUANTIFICADAS {data-orientation=rows .hidden} ======= Row {data-height=80} --------------- ### VARIABLES CATEGORICAS YA CUANTIFICADAS Y/O ORDINALES {data-width=300}
Estas tienen la peculiaridad de que tienen asignada una numeración aunque realmente son categóricas ### ESTE TIPO DE VARIABLES SON CUANTIFICADAS / ORDINALES .    PINCHE EL TIPO AL QUE QUIERE DIRIGIRSE
* Variables [cuantificables](#variables) * Variables [categoricas](#categoricas) . * Variables [cuantificadas](#cuantificadas)
Row {data-height=300} -------------- ### . > MSSubClass *** > la clase de construcción *** Codigo | Tipo -------------------- | -------------------- 20 | 1-STORY 1946 & NEWER ALL STYLES 30 | 1-STORY 1945 & OLDER 40 | 1-STORY W/FINISHED ATTIC ALL AGES 45 | 1-1/2 STORY - UNFINISHED ALL AGES 50 | 1-1/2 STORY FINISHED ALL AGES 60 | 2-STORY 1946 & NEWER 70 | 2-STORY 1945 & OLDER 75 | 2-1/2 STORY ALL AGES 80 | SPLIT OR MULTI-LEVEL 85 | SPLIT FOYER 90 | DUPLEX - ALL STYLES AND AGES 120 | 1-STORY PUD (Planned Unit Development) - 1946 & NEWER 150 | 1-1/2 STORY PUD - ALL AGES 160 | 2-STORY PUD - 1946 & NEWER 180 | PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 190 | 2 FAMILY CONVERSION - ALL STYLES AND AGES ### . > OverallQual *** > material general y calidad de acabado *** Codigo | Tipo -------------------- | -------------------- 10 | Very Excellent 9 | Excellent 8 | Very Good 7 | Good 6 | Above Average 5 | Average 4 | Below Average 3 | Fair 2 | Poor 1 | Very Poor > OverallCond *** > calificación de la condición general *** Codigo | Tipo -------------------- | -------------------- 10 | Very Excellent 9 | Excellent 8 | Very Good 7 | Good 6 | Above Average 5 | Average 4 | Below Average 3 | Fair 2 | Poor 1 | Very Poor

3 VALORES NULOS Y PERDIDOS {vertical_layout=scroll data-navmenu="1 PREPARACION"} ======== Column {data-width=250} -----------------------------------
Veamos primero cuantos valores y en cuantas columnas tenemos **NA** ```{r} columnasNA <- which(colSums(is.na(total)) > 0) kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```
Column {data-width=350} -----------------------------------
Veamos un listado de los valores **NA** usados como categoria Estaban marcados en rojo en su respectiva tabla

> **Alley**

tipo de acceso a callejones

> Codigo | Significado --------------|--------------------------------------------------- NA | No alley access > **BsmtQual**

Altura del sótano

> Codigo | Significado --------------|--------------------------------------------------- NA | No Basement > **BsmtCond**

estado general del sótano

> Codigo | Significado --------------|--------------------------------------------------- NA | No Basement > **BsmtExposure**

muros de sotano a ras de suelo o de jardín

> Codigo | Significado --------------|--------------------------------------------------- NA | No Basement > **BsmtFinType1**

Calidad del área acabada del sótano

> Codigo | Significado --------------|--------------------------------------------------- NA | No Basement > **BsmtFinType2**

Calidad del segundo área terminada (si está presente)

> Codigo | Significado --------------|--------------------------------------------------- NA | No Basement > **FireplaceQu**

calidad de la chimenea

> Codigo | Significado --------------|--------------------------------------------------- NA | No Fireplace > **GarageType**

ubicación del garaje

> Codigo | Significado --------------|--------------------------------------------------- NA | No Garage > **GarageFinish**

acabado interior del garaje

> Codigo | Significado --------------|--------------------------------------------------- NA | No Garage > **GarageQual**

calidad de garaje

> Codigo | Significado --------------|--------------------------------------------------- NA | No Garage > **GarageCond**

condición de garaje

> Codigo | Significado --------------|--------------------------------------------------- NA | No Garage > **PoolQC**

calidad de la piscina

> Codigo | Significado --------------|--------------------------------------------------- NA | No Pool > **Fence**

calidad de la cerca

> Codigo | Significado --------------|--------------------------------------------------- NA | No Fence > **MiscFeature**

característica miscelánea no cubierta en otras categorías

> Codigo | Significado --------------|--------------------------------------------------- NA | None
Column {data-width=300} -----------------------------------
Podemos apreciar que en todas las variables donde aparece (Callejon, Sotanos, Garages, Piscinas, Cerca y Varios), el sentido que se le da es "Ninguno" o "No existe". **Por lo que podemos cambiar el código en esas variables por** `NONE` ```{r} #Cambio los NA por NONE en cada variable total$Alley[is.na(total$Alley)]<-'NONE' total$BsmtQual[is.na(total$BsmtQual)]<-'NONE' total$BsmtCond[is.na(total$BsmtCond)]<-'NONE' total$BsmtExposure[is.na(total$BsmtExposure)]<-'NONE' total$BsmtFinType1[is.na(total$BsmtFinType1)]<-'NONE' total$BsmtFinType2[is.na(total$BsmtFinType2)]<-'NONE' total$FireplaceQu[is.na(total$FireplaceQu)]<-'NONE' total$GarageType[is.na(total$GarageType)]<-'NONE' total$GarageFinish[is.na(total$GarageFinish)]<-'NONE' total$GarageQual[is.na(total$GarageQual)]<-'NONE' total$GarageCond[is.na(total$GarageCond)]<-'NONE' total$PoolQC[is.na(total$PoolQC)]<-'NONE' total$Fence[is.na(total$Fence)]<-'NONE' total$MiscFeature[is.na(total$MiscFeature)]<-'NONE' ``` Volvemos a comprobar cuantas columnas quedan con valores **NA** despues de la sustitucion ```{r} columnasNA <- which(colSums(is.na(total)) > 0) kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_right') ```
4 BUSQUEDA DETALLADA POR VARIABLES {data-orientation=rows data-navmenu="1 PREPARACION"} ======== Row {data-height=50} ------------ NOS QUEDAN VALORES NULOS POR CONCRETAR EN: Row {data-height=600 vertical_layout=fill} ----------- ### **PINCHE EN CADA VARIABLE PARA VER EN DETALLE** . {data-width=600} [GARAGE](#garage)

GarageYrBlt --> 159 registros GarageCars --> 1 registros GarageArea --> 1 registros [SOTANO(BASEMENT)](#sotano)

BsmtFullBath --> 2 registros BsmtHalfBath --> 2 registros BsmtFinSF1 --> 1 registro BsmtFinSF2 --> 1 registro BsmtUnfSF --> 1 registro TotalBsmtSF --> 1 registro [MAMPOSTERIA (MasVnr)](#mamposteria)

MasVnrType --> 24 registros MaVnrArea --> 23 registros [PROPIEDAD (Lot)](#propiedad)

LotFrontage --> 486 registros [EXTERIOR](#exterior)

Exterior1st --> 1 registro Exterior2nd --> 1 registro ### **PINCHE EN CADA VARIABLE PARA VER EN DETALLE** . [UTILIDADES (Utilities)](#utilidades)

Utilities --> 2 registros [FUNCIONAL (Functional)](#funcional)

Functional --> 2 registros [ELECTRICO (Electrical)](#electrico)

Electrical --> 1 registro [COCINA (Kitchen)](#cocina)

KitchenQual --> 1 registro [VENTA (Sale)](#venta)

SaleType --> 1 registro [ZONIFICACION](#zonificacion)

MSZoning --> 4 registro [CONCLUSION](#conclusion) GARAGE{data-orientation=rows .hidden } =========

GarageYrBlt --> 159 registros GarageCars --> 1 registros GarageArea --> 1 registros
Vamos a ver con que valores de `GarageType` se correponden los **NA** de `GarageYrBlt`
```{r collapse=TRUE} prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType) prueba[,2]<-as.factor(prueba[,2]) levels(prueba[,2]) ```
Seleccionamos especificamente los registros que no tienen garaje con `NONE`
Ponemos a 0 el año en aquellos que no tienen garage
```{r echo=TRUE} prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%filter(GarageType=='NONE')%>%select(Id,GarageType) total[prueba[,1],60]<-0 ```
Vemos los registros que nos han quedado con `Detach`
```{r collapse=TRUE} prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond) kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

**REGISTRO 2577**
Parece claro que el registro 2577 no tiene garage. Ponemos `GarageType`como `NONE` y `GarageYrBlt`,`GarageCars`y `GarageArea`a 0
```{r echo=TRUE} total[2577,59]<-'NONE' total[2577,60]<-0 total[2577,62]<-0 total[2577,63]<-0 ```

**REGISTRO 2127**
Buscamos registros con `GarageType` y `GarageCars` iguales al registro 2127 y seleccionamos los mas usados
```{r collapse=TRUE} prueba2<-total%>%filter(GarageType=="Detchd"&GarageCars==1)%>%select(Id,YearBuilt,YearRemodAdd,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond) freq<-as.data.frame(table(prueba2$GarageFinish,prueba2$GarageQual,prueba2$GarageCond)) colnames(freq)<-c('GarageFinish','GarageQual','GarageCond','Cantidad') kable(head(freq[order(freq$Cantidad,decreasing = TRUE),]))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```
Asignamos
```{r echo=TRUE} total[2127,61]<-"Unf" total[2127,64]<-"TA" total[2127,65]<-"TA" ```

Miramos el valor superior entre `YearBuilt` y `YearRemodAdd`
```{r} kable(total%>%filter(Id==2127)%>%select(YearBuilt,YearRemodAdd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```
lo asignamos a `GarageYrBlt`
```{r echo=TRUE} total[2127,60]<-1983 ```

SOTANO{data-orientation=rows .hidden } ===========

BsmtFullBath --> 2 registros BsmtHalfBath --> 2 registros BsmtFinSF1 --> 1 registro BsmtFinSF2 --> 1 registro BsmtUnfSF --> 1 registro TotalBsmtSF --> 1 registro Row {data-height=1500 .tabset} ----- ### BUSQUEDA **NA**'s

Vemos los registros ```{r collapse=TRUE} prueba<-total%>%filter(is.na(BsmtFullBath)|is.na(BsmtHalfBath))%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,BsmtFullBath,BsmtHalfBath,TotalBsmtSF) kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Evidentemente ninguno de estos dos registros tiene sotano por lo que los registros que están con NA hay que ponerlos a 0 ```{r echo=TRUE} total[2121,35]<-0 total[2121,37]<-0 total[2121,38]<-0 total[2121,39]<-0 total[2121,48]<-0 total[2121,49]<-0 total[2189,48]<-0 total[2189,49]<-0 ```
### CAMPOS DISCORDANTES
Verificamos campos discordantes de sotano que tenga algun campo en `NONE` y otros no ```{r collapse=TRUE} prueba<-total%>%filter(BsmtCond=='NONE'|BsmtQual=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath) kable(prueba%>%filter(BsmtCond!='NONE'|BsmtQual!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Procedemos a modificar los campos discordantes por registros similares
### Registro 333
`BsmtFinType2`=`NONE` Buscamos registros parecidos Los valores de `BsmtFinType2` son ```{r collapse=TRUE} prueba1<-total%>%filter(BsmtCond=='TA'& BsmtQual=='Gd'& BsmtExposure=='No'& BsmtFinType1=='GLQ' & BsmtFinType2!='Unf' & BsmtFullBath==1)%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath) kable(sort(table(prueba1$BsmtFinType2),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(1,background='lawngreen') ``` Asignamos ```{r echo=TRUE} total[333,36]<-'ALQ' ```

### Registros 949,1488 y 2349
`BsmtExposure`=`NONE` Estos tres registros coinciden en los campos salvo en BsmtUnSF Buscamos registros parecidos, comparamos`BsmtExposure` ```{r collapse=TRUE} prueba1<-total%>%filter( BsmtFinType1=='Unf' & BsmtCond=='TA'& BsmtQual=='Gd' )%>%select(Id,BsmtExposure,BsmtUnfSF,TotalBsmtSF) kable(table(prueba1$BsmtExposure))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(4,background='lawngreen') kable(prop.table(table(prueba1$BsmtExposure)))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(4,background='lawngreen') muro<-ggplot(prueba1,aes(x=BsmtExposure,y=BsmtUnfSF)) muro<-muro+geom_boxplot(varwidth = TRUE) muro ```

No se aprecia relacion evidente entre el tamaño del sotano y el tipo de muro. Ademas el campo con mas casos tiene casi un 75%. Lo aplicamos en estos registros ```{r echo=TRUE} total[949,33]<-'No' total[1488,33]<-'No' total[2349,33]<-'No' ```

### Registros 2041,2186 y 2525
`BsmtCond`=`NONE` No tienen campos en comun. Buscamos por el valor mas representativo de `BsmtCond` ```{r collapse=TRUE} kable(table(total$BsmtCond))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(5,background='lawngreen') ```
Asignamos el valor `TA` ```{r echo=TRUE} total[2041,32]<-'TA' total[2186,32]<-'TA' total[2525,32]<-'TA' ```

### Registros 2218 y 2219
`BsmtQual`=`NONE` Registros con campos comunes iguales ```{r collapse=TRUE} prueba1<-total%>%filter( BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF) kable(table(prueba1$BsmtQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(3,background = 'yellow')%>%row_spec(5,background = 'yellow') ```

Estan repartidos en cantidad en `BsmtQual`. Hay que buscar mas Filtro por el campo `BsmtCond` que es diferente en cada registro Para `BsmtCond`=`Fa` ```{r collapse=TRUE} prueba1<-total%>%filter( BsmtCond=='Fa' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF) kable(table(prueba1$BsmtQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(4,background='lawngreen') ```
Para `BsmtCond`= `TA` ```{r collapse=TRUE} prueba1<-total%>%filter( BsmtCond=='TA' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF) kable(table(prueba1$BsmtQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(5,background='lawngreen') ```

En ambos casos el valor mas usado es `TA`. Lo aplicamos ```{r echo=TRUE} total[2218,31]<-'TA' total[2219,31]<-'TA' ```



Row {data-height=50} -------- MAMPOSTERIA{data-orientation=rows .hidden } ===========
Row {data-height=50} -------

MasVnrType --> 24 registros MaVnrArea --> 23 registros
Row {data-height=550 vertical_layout=scroll } ----- ### . Vamos a ver los registros con **NA** relacionados con la albañileria ```{r collapse=TRUE} prueba<-total%>%filter(is.na(MasVnrType))%>%select(Id,MasVnrType,MasVnrArea) kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ```

Uno de los elementos a seleccionar en `MasVnrType` es `None`. Ponemos los **NA** como `None` y el area a 0 ```{r echo=TRUE} total$MasVnrArea[is.na(total$MasVnrType)==TRUE]<-0 total$MasVnrType[is.na(total$MasVnrType)==TRUE]<-'None' ```

### . Compruebo si estan bien todos las areas con un tipo `None` ```{r collapse=TRUE} prueba<-total%>%filter(MasVnrType=='None' & MasVnrArea>0)%>%select(Id,MasVnrArea) kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Tenemos 7 registros que no tienen el area a 0 y no tienen mamposteria. Se ponen a 0 ```{r echo=TRUE} total$MasVnrArea[total$MasVnrType=='None'& total$MasVnrArea>0]<-0 ```
Compruebo si estan bien todos las areas con valor 0 sin tener un tipo `None` ```{r collpase=TRUE} prueba<-total%>%filter(MasVnrType!='None' & MasVnrArea==0)%>%select(Id,MasVnrType,MasVnrArea) kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Hay tres registros. Como no hay forma de saber el tipo de mamposteria, la ponemos como `NONE` ```{r echo=TRUE} total[689,26]<-'None' total[1242,26]<-'None' total[2320,26]<-'None' ```
Row {data-height=50} ----
PROPIEDAD{.hidden } ===========

LotFrontage --> 486 registros

Tenemos 486 registros con **NA**. Este es un campo cuantitativo por lo que resultan mas difíciles de definir que los categóricos. Aquí buscamos en pies la longitud de la propiedad que limita con la calle. Para poder calcularlo vamos a tener en cuenta que conocemos * `LotArea` área de la propiedad , que es cuantitativo, * `LotShape` , que es un factor que indica la configuración de la planta de la propiedad * `LotConfig` otro factor importante en Real State que indica la forma de la propiedad respecto a su entorno * `Neighborhood`, que es el entorno donde esta situada Para obtener un valor que pueda ser comparado vamos a calcular la relación entre la fachada y la raíz cuadrada del área. La forma que tiene la propiedad puede ser cuadrada, rectangular, trapezoidal, triangular, de forma irregular, etc. Elegimos la raíz cuadradada del area de un cuadrado, como lado y calculamos la proporción entre ese lado del cuadrado que tendría ese área y la longitud real de la fachada. Esa medida la vamos a agrupar por el vecindario (`Neighborhood`), la forma de la propiedad (`LotConfig`) y la regularidad de esa forma (`LotShape`) Recomendado: https://www.mpac.ca/PropertyTypes/PropertyAssessmentProcedures/ProcedureCalculationEffectiveFrontageDepthandAreaResidentialNonWaterfrontProperties https://en.wikipedia.org/wiki/Land_lot http://www.gimme-shelter.com/frontage-50043/

```{r collapse=TRUE, echo=TRUE} #registros con NA prueba1<-total%>%filter(is.na(LotFrontage)==TRUE) options(digits=4) #resto de registros agrupados prueba2<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotShape,LotConfig,Neighborhood) #Calculo proporcion prueba2[,82]<-prueba2$LotFrontage/sqrt(prueba2$LotArea) #Numero y media de las proporciones por agrupaciones prueba3<-prueba2%>%summarise(cuenta=n(),media=mean(V82)) # De cada registro con NA buscamos que agrupacion le corresponde y le asignamos la proporcion que le corresponde de su grupo adecuada a su area propia for (i in 1:length(prueba1$Id)){ lista<-which((prueba1[i,11]==prueba3$LotConfig)&(prueba1[i,8]==prueba3$LotShape)&(prueba1[i,13]==prueba3$Neighborhood)) prueba1[i,82]<-round(prueba3[lista[1],5]*sqrt(prueba1[i,5])) } nrow(table(prueba1%>%filter(is.na(media)==TRUE))) ```
Faltan 40 registros que no estan conformados por los tres campos. Reducimos las agrupaciones a dos. `LotConfig` y `Neighborhood` Realizamos las mismas operaciones que en el chunk anterior ```{r collapse=TRUE} prueba11<-prueba1%>%filter(is.na(media)==TRUE) prueba22<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotConfig,Neighborhood) prueba22[,82]<-prueba22$LotFrontage/sqrt(prueba22$LotArea) prueba23<-prueba22%>%summarise(cuenta=n(),media=mean(V82)) for (i in 1:length(prueba11$Id)){ lista<-which((prueba11[i,11]==prueba23$LotConfig)&(prueba11[i,13]==prueba23$Neighborhood)) prueba11[i,82]<-round(prueba23[lista[1],4]*sqrt(prueba11[i,5])) } nrow(table(prueba11%>%filter(is.na(media)==TRUE))) ```
Faltan 4 registros que no estan conformados por los dos campos. Reducimos a `Neighborhood` y realizamos las misma operaciones ```{r collapse=TRUE} prueba111<-prueba11%>%filter(is.na(media)==TRUE) prueba222<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(Neighborhood) prueba222[,82]<-prueba222$LotFrontage/sqrt(prueba222$LotArea) prueba223<-prueba222%>%summarise(cuenta=n(),media=mean(V82)) for (i in 1:length(prueba111$Id)){ lista<-which(prueba111[i,13]==prueba223$Neighborhood) prueba111[i,82]<-round(prueba223[lista[1],3]*sqrt(prueba111[i,5])) } nrow(table(prueba111%>%filter(is.na(media)==TRUE))) ```
Ya no quedan registros con **NA** en `media`. Unimos todos los grupos de registros que hemos hecho. Reasignamos el valor de `media` a `LotFrontage` y ordenamos el conjunto ```{r} prueba<-rbind(prueba1[is.na(prueba1$media)==FALSE,],prueba11[is.na(prueba11$media)==FALSE,],prueba111[is.na(prueba111$media)==FALSE,]) prueba$LotFrontage<-prueba$media total<-rbind(total[is.na(total$LotFrontage)==FALSE,],prueba[,1:81]) #reordenamos total<-total%>%arrange(Id) ```



EXTERIOR{data-orientation=rows vertical_layout=scroll .hidden } ===========

Exterior1st --> 1 registro Exterior2nd --> 1 registro Tenemos dos variables categóricas con 1 **NA** cada una en el mismo registro.
```{r collapse=TRUE} kable(total%>%filter(is.na(Exterior1st)==TRUE)%>%select(Id,Exterior1st,Exterior2nd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```
Vemos la distribucion Row { data-height=750 vertical_layout=scroll} ------- ### . ```{r} kable(sort(table(total$Exterior1st),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

### . ```{r} kable(sort(table(total$Exterior2nd),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Row {data-height=50 vertical_layout=scroll} ------ Sin mas información escogemos lo mas frecuente
Column {data-height=100} ---------

```{r echo=TRUE} total[2152,24]<-'VinylSD' total[2152,25]<-'VinylSD' ```
Row {data-height=50} ------ UTILIDADES{data-orientation=rows .hidden } ===========

Utilities --> 2 registros
Tenemos 2 registros con **NA** en este campo Vemos como estan distribuidos Row {data-height=1000 } ------ ### . ```{r collapse=TRUE} kable(total%>%filter(is.na(Utilities)==TRUE)%>%select(Id,Utilities))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ``` ### . ```{r collapse=TRUE} kable(sort(table(total$Utilities),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Row {dat-height=100} ----
Como parece evidente ponemos estos dos registros como la inmensa mayoría. Aunque tenerlos casi todos iguales no servirá para predecir nada Column{dat-height=100} ------ ```{r echo=TRUE} total[1916,10]<-'AllPub' total[1946,10]<-'AllPub' ```


Row{data-height=50} ---- FUNCIONAL{data-orientation=rows .hidden } ===========

Functional --> 2 registros
Tenemos 2 registros con **NA** en este campo. Vemos como esta distribuido Row {data-height=1700} ---- ### . ```{r collapse=TRUE} kable(total%>%filter(is.na(Functional)==TRUE)%>%select(Id,Functional))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ``` ### . ```{r} kable(sort(table(total$Functional),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Row{dat-height=100} ---- Ponemos estos registros como `Typical` que son la mayoría. No tenemos información para mas Column{dat-height=100} ---- ```{r echo=TRUE} total[2217,56]<-'Typ' total[2474,56]<-'Typ' ```


Row{data-height=50} ------ ELECTRICO{.hidden } ===========

Electrical --> 1 registro
Tenemos 1 registro con **NA** en este campo ```{r collapse=TRUE} kable(total%>%filter(is.na(Electrical)==TRUE)%>%select(Id,Electrical))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') kable(sort(table(total$Electrical),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```
Ponemos este registro como la mayoría, el estándar ```{r echo=TRUE} total[1380,43]<-'SBrkr' ```
COCINA{data-orientation=rows .hidden } =========== Row {data-height=80} ----

KitchenQual --> 1 registro
Row {data-height=1500} ----- ### . Tenemos 1 registro con **NA** ```{r collapse=TRUE} kable(total%>%filter(is.na(KitchenQual)==TRUE)%>%select(Id,KitchenQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') kable(sort(table(total$KitchenQual),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho ```{r echo=TRUE} total[1556,54]<-'TA' ```
### . Por otro lado tenemos tres registros con un numero de cocinas por encima del suelo igual a 0, pero sin embargo su calidad es `Typical` ```{r collapse=TRUE} kable(total%>%filter(KitchenAbvGr==0)%>%select(Id,KitchenAbvGr,KitchenQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

En principio no es paradójico puesto que no existe la opción de `NONE` en `KitchenQual`
Row {data-height=50} ------- VENTA{.hidden } ===========

SaleType --> 1 registro
Tenemos 1 registro con **NA** en el campo `SaleType` ```{r collapse=TRUE} kable(total%>%filter(is.na(SaleType)==TRUE)%>%select(Id))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') kable(sort(table(total$SaleType),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```
Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho ```{r echo=TRUE} total[2490,79]<-'WD' ```
ZONIFICACION{data-orientation=rows .hidden } ===========

MSZoning --> 4 registro Row {.tabset } -------- ### NUMERO **NA**'s

Tenemos 4 registros con **NA** ```{r collapse=TRUE} kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),full_width =F,font_size=12,position = 'float_left') ```

### OBSERVACIONES

Estas son el numero de observaciones ```{r collapse=TRUE} kable(sort(table(total$MSZoning),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ``` ### GRAFICO

En este caso vamos a ver la relación entre: * el tipo de zonificación `MSZoning` * el barrio `Neighborhood`

```{r collapse=TRUE} plotPru<-ggplot(data=total,aes(x=total$Neighborhood,y=total$MSZoning)) plotPru<-plotPru+geom_count()+labs(x="BARRIOS",y="ZONIFICACION") plotPru<-plotPru+theme(axis.text.x = element_text(angle = 90,hjust=1,vjust=0.5),title = element_text(color="blue",size=12,lineheight = 1)) plotPru ```

### BUSQUEDA **NA**

Compruebo los registros con **NA** ```{r collape=TRUE} kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id,MSZoning,Neighborhood))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

### BARRIO IDOTRR

Vuelvo a comprobar separando los barrios. Para los registros del barrio de `IDOTRR`donde tenemos tres registros no existe ninguna vivienda zonificada como `RL` que es la mayoritaria en el conjunto de Ames. ```{r collapse=TRUE} prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='IDOTRR') kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Escojo como valor mayoritario `RM` ```{r echo=TRUE} total[1916,3]<-'RM' total[2217,3]<-'RM' total[2251,3]<-'RM' ```
### BARRIO Mitchel

En el barrio de `Mitchel` , donde esta el otro registro, sí es `RL` la mayoritaria ```{r collapse=TRUE} prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='Mitchel') kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Escojo como valor mas usado `RL` ```{r echo=TRUE} total[2905,3]<-'RL' ```



Row {data-height=50} ----- CONCLUSION{.hidden } ===========

Comprobamos cuantos valores nos quedan con **NA** ```{r collapse=TRUE} #Comprobamos cuantos NA nos quedan ColumnasNA <- which(colSums(is.na(total)) > 0) kable(sort(colSums(sapply(total[ColumnasNA], is.na)), decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Que es la variable objetivo



5. CONTRADICCIONES {data-orientation=rows data-navmenu="1 PREPARACION"} =========== **Vamos a buscar contradicciones entre características similares** Row {.tabset} --------- ### PISCINA (Pool) {vertical_layout=TRUE}

No se puede establecer una relacion directa entre la calidad de la piscina y el area. Buscaremos en la calidad general de la casa ```{r collapse=TRUE} kable(total%>%filter(PoolArea>0 & PoolQC=='NONE')%>%select(Id,PoolQC,PoolArea))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Tenemos tres registros que tienen un area de piscina sin tenerla Vemos como están distribuidas las piscinas ```{r collapse=TRUE} kable(sort(table(total$PoolQC),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

La gran mayoría de las casas no tienen piscina. De esas 10 que si tienen mas las tres que nos faltan hay que poder encontrar un criterio con el que dar una cualificación a los registros que faltan. Buscaremos algún tipo de relación ```{r collapse=TRUE} prueba<-total%>%filter(PoolArea>0 )%>%select(Id,PoolQC,PoolArea,OverallQual,OverallCond) kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$OverallQual)) plotPru2<-plotPru2+geom_boxplot() plotPru2 plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$PoolArea)) plotPru2<-plotPru2+geom_boxplot() plotPru2 ```

Parece que existe cierta relacion entre la calidad general y el area de piscina Vamos a verlo numericamente . Llamo `razon` a la proporcion `OverallQual`*100/`PoolArea` ```{r collapse=TRUE} options(digits = 3) prueba$razon<-(prueba$OverallQual*100)/prueba$PoolArea #Ordenamos prueba<-prueba%>%arrange(desc(prueba$razon)) kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left') ```

Si se puede establecer una cierta relación , por lo que asignamos la calidad de la piscina asi, teniendo en cuenta que good `Gd` es mejor que fair `Fa` ```{r echo=TRUE} total[2504,73]<-'Gd' total[2421,73]<-'Gd' total[2600,73]<-'Fa' ``` ### CHIMENEA (Fireplace)

No existe contradiccion entre el numero de chimeneas y la calidad

```{r collapse=TRUE, echo=TRUE} nrow(total%>%filter(Fireplaces>0 & FireplaceQu=='NONE')%>%select(Id,Fireplaces,FireplaceQu,OverallQual,OverallCond)) ```

### SOTANO (Basement)

En las areas tenemos que el area del tipo 1 + area del tipo 2 + area sin terminar = Area total Comprobamos y buscamos incongruencias ```{r collapse=TRUE,echo=TRUE} prueba<-total%>%select(Id,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF) prueba[,2]<--prueba[,2] prueba[,6]<-apply(prueba[,2:5],1,sum) nrow(prueba%>%filter(V6>0)) ``` No existe ningun registro con el area mal

En los registros sin sotano compruebo que no exista algún campo que no corresponda Existen 79 registros que no tienen sotano ```{r collapse=TRUE,echo=TRUE} prueba<-total%>%filter(BsmtQual=='NONE'|BsmtCond=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath) prueba1<-prueba%>%filter(BsmtQual!='NONE'|BsmtCond!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'|BsmtFullBath>0|BsmtHalfBath>0)%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath) nrow(prueba1) ``` Ninguno de ellos tiene incongruencias

Busco los sotanos existentes que no tienen area construida en el primer tipo ```{r echo=TRUE} prueba<-total%>%filter(BsmtFinType1!='NONE' & BsmtFinSF1==0 )%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF) table(prueba$BsmtFinType1,prueba$BsmtFinType2) ```

Esos 851 no tiene tampoco del segundo tipo `Unf` ```{r echo=TRUE} table(prueba$BsmtFinSF1,prueba$BsmtFinSF2) ```

Las areas son 0 en todos los casos ```{r echo=TRUE} nrow(prueba%>%filter(prueba$BsmtUnfSF==0)) ```

Todos los registros aparecen como `Unf` Inacabado. Es correcto ### GARAGE

En los inmuebles sin garaje buscamos registros que tengan campos con contradicciones o incongruencias ```{r collapse=TRUE,echo=TRUE} prueba<-total%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE')%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars) nrow(prueba%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)) ```

En los inmuebles con garaje buscamos registros que tengan campos con contradicciones o incongruencias ```{r collapse=TRUE,echo=TRUE} prueba<-total%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars) nrow(prueba%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE' | GarageYrBlt==0 | GarageCars==0 | GarageArea==0)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)) ```

6. TIPOLOGIAS{ data-navmenu="1 PREPARACION"} =========== Column {.tabset} ------------ ### **CATEGORICAS**

Teniendo en cuenta que para el análisis con las variable independientes categóricas se crearan variables "dummy", tantas como categorías-1 por cada variable, parece claro pensar que favorece reducir el numero de variables, reduciendo la complejidad.

En nuestro caso , y en mi opinión es posible realizarlo cambiando ciertas variables de categóricas a ordinales. Sobre todo en aquellas que tengan un orden que parezca lógico.

Para seguir un criterio razonable, he escogido la transformación creciente desde 0 hasta el numero de categorías dentro de cada variable, siempre desde menos a mas, o si se prefiere de peor a mejor, pero con la salvedad de que 0 solo se escoge para la categoría que significa que no existe esa variable.

Por simplificar con un ejemplo, puedo tener una variable que me habla de la calidad del acabado del garaje, dentro de las cuales tengo varias categorías que van desde una mala calidad a una muy buena. Evidentemente el orden es creciente con el máximo valor para la mejor de las categorías, pero el 0 se reserva solo si dentro de esas categorías me aparece una indicando que no tiene garaje

Estas son las variables categóricas que he seleccionado, y al lado la asignación que le doy a cada categoría de cada una de ellas [VER](#tipocategoricas) ### **ORDINALES**

Vamos a revisar las variables que ya teníamos como ordinales en los datos originales
Mientras que `OverallQual` y `OverallCond` no ofrecen ninguna duda, `MSSubclass` me parece que no esta correctamente planteada.
Puede que se usara ese código numerico para identificar mejor las distintas clases de edificación pero no tiene una relación ordinal
Se puede apreciar en el grafico con la relación que tiene con el precio
[VER](#tipoordinales) ### **CUANTITATIVAS** En el caso de variables cuantitativas originalmente en el dataset , vamos a revisar aquellas que no tengan justificación como numericas Antes de empezar voy a revisar la normalidad de las variables cuantitativas para lo cual he creado un pequeño codigo que me indica la normalidad `SI` o `NO` de las variables ```{r} #Columnas con valores numericos NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) #Preparar datos options(digits=18) normal<-data.frame() for (i in 1:length(TrainNum)){ normal[i,1]<-colnames(TrainNum[i]) normal[i,2]<-shapiro.test(TrainNum[,i])[[2]] if (normal[i,2]<0.05) { normal[i,3]<-'NO' }else { normal[i,3]<-'SI' } } colnames(normal)<-c('Variable','p-value') #Numero de variables normales(SI o NO) table(normal[,3]) ``` El resultado es que ninguna de las variables numéricas tienen normalidad. Esto me sirve para seleccionar el método de correlacion de Spearman Vemos las variables cuantitativas susceptibles de cambiarse a categoricas En principio voy a revisar aquellas cuya cantidad represente algo en si misma, y en esta categoría entran todo lo referido a fechas. Repasando una por una En la categoria de fechas se encuentran las 4 primeras [MOSOLD (Mes venta)](#mosold) [YRSOLD (Año venta)](#yrsold) [YearBuilt YearRemodAdd (Año de construccion y Año de remodelacion)](#yearbuilt-yearremodadd) [GarageYrBuilt (Año en el que fue construido el garage)](#garageyrbuilt)
Veremos a continuacion el resto de variables cuantitativas y relación entre ellas para poder ver si reducimos su numero. Voy a crear una matriz de correlaciones entre estas variables sin contar en principio con el precio. Para saber si existe una dependencia entre algunas de ellas que nos pueda servir. Para eso uso el paquete `corrplot` Esta es la revision general [REVISION RESTO CUANTITATIVAS (Sin relacion con fechas)](#revision-resto-cuantitativas)
Vere a continuación las variables con una fuerte correlacion por si se puede reducir el numero de variables predictoras [ANTIGUEDAD y ANTGARAGE](#antiguedad-y-antgarage) [GARAGECARS Y GARAGEAREA](#garagecars-y-garagearea) [FIREPLACES y FIREPLACEQU](#fireplaces-y-fireplacequ) [1STFlRSF y TOTALBSMTSF](#stflrsf-y-totalbsmtsf) [GRLIVAREA FULLBATH TOTRMSABVGRD](#grlivarea-fullbath-totrmsabvgrd) [Normalizacion de resto de variables](#normalizacion-de-resto-de-variables) [CONCLUSION](#conclusion-1) Todos estos epigrafes se encuentran ademas en el menu **`2 PREPARACION`** ### **FACTORES** En el caso del estudio de las variables categóricas, tenemos que partir de un enfoque diferente
Como estamos hablando de variables categóricas no podemos en principio calcular un valor directo como usábamos el de la correlacion en las variables continuas.
Pero si podemos usar el coeficiente de determinación o bondad del ajuste que en los casos de regresion lineal simple es el cuadrado de la correlacion de Pearson.
Luego la forma de seleccionar aquellas variables que tienen influencia sobre el precio va a ser calcular el coeficiente de determinación
Para facilitar esto vamos a usar el paquete `FactoMineR`.
Esta todo detallado en el menu **`3 PREPARACION`** TIPOCATEGORICAS {data-orientation=rows .hidden} ======= Row --------------- ### [VOLVER A TIPOLOGIAS](#tipologias) > LotShape *** > forma general de la propiedad *** Codigo | Tipo -------------------- | -------------------- Reg **4** | Regular IR1 **3** | Slightly irregular IR2 **2** | Moderately Irregular IR3 **1** | Irregular > LandSlope *** > Pendiente de la propiedad *** Codigo | Tipo -------------------- | -------------------- Gtl **3** | Gentle slope Mod **2** | Moderate Slope Sev **1** | Severe Slope > ExterQual *** > calidad del material exterior *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent Gd **4** | Good TA **3** | Average/Typical Fa **2** | Fair Po **1** | Poor > ExterCond *** > estado actual del material en el exterior *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent Gd **4** | Good TA **3** | Average/Typical Fa **2** | Fair Po **1** | Poor > BsmtQual *** > Altura del sótano *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent (100+ inches) Gd **4** | Good (90-99 inches) TA **3** | Typical (80-89 inches) Fa **2** | Fair (70-79 inches) Po **1** | Poor (<70 inches NONE **0** | No Basement > BsmtCond *** > estado general del sótano *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent Gd **4** | Good TA **3** | Typical - slight dampness allowed Fa **2** | Fair - dampness or some cracking or settling Po **1** | Poor - Severe cracking, settling, or wetness NONE **0** | No Basement > BsmtExposure *** > muros de sotano a ras de suelo o de jardín *** Codigo | Tipo -------------------- | -------------------- Gd **4** | Good Exposure Av **3** | Average Exposure (split levels or foyers typically score average or above) Mn **2** | Mimimum Exposure No **1** | No Exposure NONE **0** | No Basement > BsmtFinType1 *** > Calidad del área acabada del sótano *** Codigo | Tipo -------------------- | -------------------- GLQ **6** | Good Living Quarters ALQ **5** | Average Living Quarters BLQ **4** | Below Average Living Quarters Rec **3** | Average Rec Room LwQ **2** | Low Quality Unf **1** | Unfinshed NONE **0** | No Basement ### [VOLVER A TIPOLOGIAS](#tipologias) > BsmtFinType2 *** > Calidad del segundo área terminada (si está presente) *** Codigo | Tipo -------------------- | -------------------- GLQ **6** | Good Living Quarters ALQ **5** | Average Living Quarters BLQ **4** | Below Average Living Quarters Rec **3** | Average Rec Room LwQ **2** | Low Quality Unf **1** | Unfinshed NONE **0** | No Basement > HeatingQC *** > Calidad y condición de la calefacción *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent Gd **4** | Good TA **3** | Average/Typical Fa **2** | Fair Po **1** | Poor > KitchenQual *** > calidad de la cocina *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent Gd **4** | Good TA **3** | Average/Typical Fa **2** | Fair Po **1** | Poor > FireplaceQu *** > calidad de la chimenea *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent - Exceptional Masonry Fireplace Gd **4** | Good - Masonry Fireplace in main level TA **3** | Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement Fa **2** | Fair - Prefabricated Fireplace in basement Po **1** | Poor - Ben Franklin Stove NONE **0** | No Fireplace > GarageFinish *** > acabado interior del garaje *** Codigo | Tipo -------------------- | -------------------- Fin **3** | Finished RFn **2** | Rough Finished Unf **1** | Unfinished NONE **0** | No Garage > GarageQual *** > calidad de garaje *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent Gd **4** | Good TA **3** | Average/Typical Fa **2** | Fair Po **1** | Poor NONE **0** | No Garage > GarageCond *** > condición de garaje *** Codigo | Tipo -------------------- | -------------------- Ex **5** | Excellent Gd **4** | Good TA **3** | Average/Typical Fa **2** | Fair Po **1** | Poor NONE **0** | No Garage > PoolQC *** > calidad de la piscina *** Codigo | Tipo -------------------- | -------------------- Ex **4** | Excellent Gd **3** | Good TA **2** | Average/Typical Fa **1** | Fair NONE **0** | No Pool ### [VOLVER A TIPOLOGIAS](#tipologias)

```{r echo=TRUE} #Guardamos los cambios y los vuelvo a abrir para que me convierta los caracteres a factor write.csv(total,file="Total1.csv",row.names = FALSE) total<-read.csv("Total1.csv",sep=",",header = TRUE) ```

Las cambiamos ```{r echo=TRUE,message=FALSE,warnings=FALSE} total$BsmtCond<-plyr::revalue(total$BsmtCond,c('NONE'='0','Po'='1','Fa'='2','TA'='3','Gd'='4','Ex'=5)) total$BsmtExposure<-plyr::revalue(total$BsmtExposure,c('NONE'=0,'No'=1,'Mn'=2,'Av'=3,'Gd'=4)) total$BsmtFinType1<-plyr::revalue(total$BsmtFinType1,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6)) total$BsmtFinType2<-plyr::revalue(total$BsmtFinType2,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6)) total$BsmtQual<-plyr::revalue(total$BsmtQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$ExterCond<-plyr::revalue(total$ExterCond,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$ExterQual<-plyr::revalue(total$ExterQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$FireplaceQu<-plyr::revalue(total$FireplaceQu,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$GarageCond<-plyr::revalue(total$GarageCond,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$GarageFinish<-plyr::revalue(total$GarageFinish,c('NONE'=0,'Unf'=1,'RFn'=2,'Fin'=3)) total$GarageQual<-plyr::revalue(total$GarageQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$HeatingQC<-plyr::revalue(total$HeatingQC,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$KitchenQual<-plyr::revalue(total$KitchenQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5)) total$LandSlope<-plyr::revalue(total$LandSlope,c('Sev'=1,'Mod'=2,'Gtl'=3)) total$LotShape<-plyr::revalue(total$LotShape,c('IR3'=1,'IR2'=2,'IR1'=3,'Reg'=4)) total$PoolQC<-plyr::revalue(total$PoolQC,c('NONE'=0,'Fa'=1,'TA'=2,'Gd'=3,'Ex'=4)) total$BsmtCond<-as.numeric(levels(total$BsmtCond))[total$BsmtCond] total$BsmtExposure<-as.numeric(levels(total$BsmtExposure))[total$BsmtExposure] total$BsmtFinType1<-as.numeric(levels(total$BsmtFinType1))[total$BsmtFinType1] total$BsmtFinType2<-as.numeric(levels(total$BsmtFinType2))[total$BsmtFinType2] total$BsmtQual<-as.numeric(levels(total$BsmtQual))[total$BsmtQual] total$ExterCond<-as.numeric(levels(total$ExterCond))[total$ExterCond] total$ExterQual<-as.numeric(levels(total$ExterQual))[total$ExterQual] total$FireplaceQu<-as.numeric(levels(total$FireplaceQu))[total$FireplaceQu] total$GarageCond<-as.numeric(levels(total$GarageCond))[total$GarageCond] total$GarageFinish<-as.numeric(levels(total$GarageFinish))[total$GarageFinish] total$GarageQual<-as.numeric(levels(total$GarageQual))[total$GarageQual] total$HeatingQC<-as.numeric(levels(total$HeatingQC))[total$HeatingQC] total$KitchenQual<-as.numeric(levels(total$KitchenQual))[total$KitchenQual] total$LandSlope<-as.numeric(levels(total$LandSlope))[total$LandSlope] total$LotShape<-as.numeric(levels(total$LotShape))[total$LotShape] total$PoolQC<-as.numeric(levels(total$PoolQC))[total$PoolQC] ```

TIPOORDINALES { .hidden} ========= Revision de las ordinales originales Column{data-width=1000} ------- ```{r collapse=TRUE} Train<-total%>%filter(is.na(SalePrice)==FALSE) PlotClas<-ggplot() PlotClas<-PlotClas+geom_col(data=Train,aes(x=Train$MSSubClass,y=Train$SalePrice),fill="lightblue") PlotClas<-PlotClas+labs(x="Clases",y="Precios") PlotClas ```

Column {data-width=500} ------ Cambiamos de ordinal a categorica ```{r echo=TRUE} Cod<-c('20'='1-STORY 1946 & NEWER ALL STYLES','30'='1-STORY 1945 & OLDER','40'='1-STORY W/FINISHED ATTIC ALL AGES','45'='1-1/2 STORY - UNFINISHED ALL AGES','50'='1-1/2 STORY FINISHED ALL AGES','60'='2-STORY 1946 & NEWER','70'='2-STORY 1945 & OLDER','75'='2-1/2 STORY ALL AGES','80'='SPLIT OR MULTI-LEVEL','85'='SPLIT FOYER','90'='DUPLEX - ALL STYLES AND AGES','120'='1-STORY PUD (Planned Unit Development) - 1946 & NEWER','150'='1-1/2 STORY PUD - ALL AGES','160'='2-STORY PUD - 1946 & NEWER','180'='PUD - MULTILEVEL - INCL SPLIT LEV/FOYER','190'='2 FAMILY CONVERSION - ALL STYLES AND AGES') total$MSSubClass<-as.factor(total$MSSubClass) total$MSSubClass<-plyr::revalue(total$MSSubClass,Cod) ```

[VOLVER A TIPOLOGIAS](#tipologias) 1. MOSOLD{.storyboard data-navmenu="2 PREPARACION"} ========= ### Vemos como se distribuye ```{r collapse=TRUE} options(digits=6) mes1<-ggplot() mes1<-mes1+geom_bar(data=TotalNum,aes(x=TotalNum$MoSold),fill='blue',position = 'stack') mes1<-mes1+geom_bar(data=TrainNum,aes(x=TrainNum$MoSold),fill='red',position = 'stack') mes1<-mes1+labs(x='MESES',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12)) mes1 ``` *** En azul el total de viviendas, y por encima en rojo solo el conjunto de entrenamiento. No parece que haya excesivas diferencias y en la mayoría de los meses se aprecia visualmente que el conjunto de entrenamiento representa la mitad del total. Podemos apreciar que la numeración se refiere evidentemente a los meses y refleja una distribución en la venta superior en los meses de Mayo, Junio y Julio. ### Veamos si eso afecta a el precio de venta en el conjunto Train ```{r collapse=TRUE} mes<-ggplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice)) mes<-mes+stat_summary(fun.data = give.n, geom = "text", fun.y = mean) mes<-mes+geom_bar(stat="summary",fun.y="mean",fill="royalblue") mes<-mes+labs(x='MESES',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12)) mes<-mes+scale_y_continuous(labels = scales::comma) mes ``` *** El precio medio es parecido y no se ve relación con el mes (por encima aparece la cantidad) ### Boxplot ```{r collapse=TRUE} mes2<-ggplot() mes2<-mes2+geom_boxplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice,group=TrainNum$MoSold)) mes2<-mes2+labs(x='MESES',y='PRECIO ')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12)) mes2<-mes2+scale_y_continuous(labels = scales::comma) mes2 ``` ### Vemos correlacion ```{r echo=TRUE} cor(x=TrainNum$MoSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete") ``` *** En mi opinión con esa correlacion tan próxima a 0 no influye para nada en el precio 2. YRSOLD{.storyboard data-navmenu="2 PREPARACION"} ============ ### Tenemos un total de cuatro años. Veamoslo gráficamente al igual que con los meses ```{r collapse=TRUE} year1<-ggplot() year1<-year1+geom_bar(data=TotalNum,aes(x=TotalNum$YrSold),fill='blue',position = 'stack') year1<-year1+geom_bar(data=TrainNum,aes(x=TrainNum$YrSold),fill='red',position = 'stack') year1<-year1+labs(x='AÑOS',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5)) year1 ``` ### La media por año con el numero de casos ```{r collapse=TRUE} year<-ggplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice)) year<-year+stat_summary(fun.data = give.n, geom = "text", fun.y = mean) year<-year+geom_bar(stat="summary",fun.y="mean",fill="royalblue") year<-year+labs(x='AÑOS',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5)) year<-year+scale_y_continuous(labels = scales::comma) year ``` ### Boxplot ```{r collapse=TRUE} year2<-ggplot() year2<-year2+geom_boxplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice,group=TrainNum$YrSold)) year2<-year2+labs(x='AÑOS',y='PRECIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5)) year2<-year2+scale_y_continuous(labels = scales::comma) year2 ``` ### Vemos correlacion ```{r echo=TRUE} cor(x=TrainNum$YrSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete") ``` *** Tienen una correlacion cercana a 0 lo cual indica una influencia en el precio infima Tiene la particularidad de que nos puede servir para considerar la antigüedad de la vivienda y ahí puede ser relevante su uso. Voy a posponerlo para mas adelante cuando veamos el año de construcción y el de remodelación 3. YEARBUILT YEARREMODADD{.storyboard data-navmenu="2 PREPARACION"} ======= ### Vamos a ver gráficamente la relación con el precio de venta del año de construccion ```{r collapse=TRUE} built<-ggplot() built<-built+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice),color='blue') built<-built+labs(x='AÑOS',y='PRECIO',title='CONSTRUCCION')+scale_y_continuous(labels = scales::comma) built ``` *** Vemos estas dos variables puesto que están muy relacionadas. El año de construccion no necesita explicación, en cuanto a el año de remodelacion es el año en que la vivienda ha sufrido algún tipo de reforma. Si no ha tenido ninguna esta se corresponde con la fecha de construcción. ### Vemos ahora para el año de remodelación ```{r collapse=TRUE} built1<-ggplot() built1<-built1+geom_point(data=TrainNum,aes(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice),color='red') built1<-built1+labs(x='AÑOS',y='PRECIO',title= 'REMODELACION')+scale_y_continuous(labels = scales::comma) built1 ``` *** Tiene la peculiaridad de que computa a partir de 1950, y en ese año tiene un numero extraordinario de casos, 178 en el Train y 361 en el total, seguramente porque se empezaría a computar ese año y todas las que tienen una antigüedad mayor se computan aqui ### Parece razonable pensar a la vista de las graficas que existe algún tipo de relación con el precio de venta. Numericamente: ```{r echo=TRUE} #Correlacion año construccion cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete") #Correlacion año remodelacion cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete") ``` *** ¿Que pasaria si distinguimos aquellas casas que han sido remodeladas , y por lo tanto su fecha de remodelacion es diferente a la de construccion, de aquellas que no lo han sido? ### Prueba de remodelacion.
Creamos una columna.
No remodelados=0. Remodelados=1 ```{r } TrainNum$Remodelado<-0 TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1 #Dividimos el dataset T1<-TrainNum%>%filter(Remodelado==1) T0<-TrainNum%>%filter(Remodelado==0) ``` ```{r echo=TRUE} #Calculamos correlacion para remodelados #Correlacion año construccion cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete") #Correlacion año remodelacion cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete") #No remodelados cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete") ``` *** Esta claro que importa el año de construccion, importa el año de remodelacion, importa si estan o no remodeladas en cuanto afecta a su antigüedad y además tenemos unos valores extraños en 1950 que debemos corregir. Voy a considerar que ninguna de esas viviendas situadas en 1950 han sido remodeladas por lo que aplicare a esa variable, la del año de construcción ### Aplico a la remodelacion de los de 1950 el año de construccion y recalculamos ```{r} total$YearRemodAdd[total$YearRemodAdd<1951]<-total$YearBuilt[total$YearRemodAdd<1951] #Recargamos los datos NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) #Vuelvo a comprobar correlacion TrainNum$Remodelado<-0 TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1 #Dividimos el dataset T1<-TrainNum%>%filter(Remodelado==1) T0<-TrainNum%>%filter(Remodelado==0) ``` ```{r echo=TRUE} #Calculamos correlacion para remodelados #Correlacion año construccion cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete") #Correlacion año remodelacion cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete") #No remodelados cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete") ``` ### Graficamente ```{r collapse=TRUE} built3<-ggplot() built3<-built3+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,color=Remodelado)) built3<-built3+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none') built3<-built3+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION VIVIENDAS')+scale_y_continuous(labels = scales::comma) built3 ``` *** Vamos a afinar un poco mas calculando la antigüedad respecto al año de venta. Creamos una columna nueva ### Calculo antiguedad completa y comprobamos posibles errores ```{r collapse=TRUE} total$Antiguedad<-total$YrSold-total$YearBuilt #Recargamos los datos NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) #Buscamos errores kable(TotalNum%>%filter(Antiguedad<0)%>%select(Id,YearBuilt,YrSold))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` ```{r echo=TRUE} total[2550,78]<-2008 ``` ```{r} #Recargamos los datos NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) ``` *** Existe un registro con el año de venta anterior al de la construccion. Lo igualo Buscarè errores también en el año de remodelación ### Revision de incongruencia de datos con YearRemodAdd ```{r collapse=TRUE} kable(TotalNum%>%filter((TotalNum$YrSold-TotalNum$YearRemodAdd)<0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` ```{r echo=TRUE} total[524,21]<-2007 total[2296,21]<-2007 total[2550,21]<-2008 ``` *** Corrijo los valores del año de remodelacion posteriores al año de construccion y venta, y pongo los valores de este ultimo ### Mas incongruencias ```{r collapse=TRUE} kable(TotalNum%>%filter((TotalNum$YearBuilt-TotalNum$YearRemodAdd)>0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` ```{r echo=TRUE} total[1877,21]<-2002 ``` *** El año de remodelacion es anterior al de construccion Corrijo los valores al año de construccion ### Volvemos a calcular y actualizar ```{r} total$Antiguedad<-total$YrSold-total$YearBuilt #Recargamos los datos NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) #Vuelvo a comprobar correlacion TrainNum$Remodelado<-0 TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1 #Dividimos el dataset T1<-TrainNum%>%filter(Remodelado==1) T0<-TrainNum%>%filter(Remodelado==0) ``` ```{r echo=TRUE} #Calculamos correlacion para remodelados cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete") #No remodelados cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete") ``` *** Al cambiar el calculo sobre la antiguedad se invierte el signo de la correlacion ### Graficamente la antiguedad ```{r collapse=TRUE} built4<-ggplot() built4<-built4+geom_point(data=TrainNum,aes(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,color=Remodelado)) built4<-built4+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none') built4<-built4+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD VIVIENDAS')+scale_y_continuous(labels = scales::comma) built4 ``` *** Los valores son parecidos pero al calcular sobre el numero de años se invierte el signo En conclusión, la antigüedad de la vivienda tiene una relación fuerte con el precio de venta, y además el hecho de ser una vivienda remodelada o no tambien es importante. Le afecta menos cuando se ha realizado dicha remodelación. ### Por lo cual calculamos la antigüedad (ya realizado), calculamos si hay o no remodelación {data-commentary-width=600} ```{r echo=TRUE} #Conclusiones total$Remodelado<-0 total$Remodelado[total$YearBuilt!=total$YearRemodAdd]<-1 #Recargamos los datos NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] ``` *** Si calculamos la correlacion de la antiguedad respecto al precio tenemos un valor **`r cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")`**. Hemos visto que los remodelados tienen **`r cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete")`** y los no remodelados **`r cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete")`** lo que significa que están penalizados por el calculo conjunto. Podriamos pensar que si tomamos la antigüedad como la diferencia entre el año de venta y el de remodelación(teniendo en cuenta que para las viviendas no remodeladas este es igual que el de construcción) obtendríamos una variable mas adecuada, pero es al contrario , el valor de la correlacion es **`r cor(x=(TrainNum$YrSold-TrainNum$YearRemodAdd),y=TrainNum$SalePrice,method="spearman",use="na.or.complete")`**. Hay que encontrar una manera de penalizar a las viviendas remodeladas en su antigüedad Mi propuesta es penalizar a las viviendas que han sido remodeladas aumentando su antigüedad de manera artificial. Proporcionalmente al tiempo que se ha tardado en remodelar. ¿Cuánto?. La decima porcentual que tienen de diferencia las correlaciones. ### Vemos los valores y penalizamos ```{r echo=TRUE} #Penalizacion TotalNum.remo<-TotalNum%>%filter(Remodelado==1) summary(TotalNum.remo$YearRemodAdd-TotalNum.remo$YearBuilt) ``` ```{r echo=TRUE} total$Penaliza<-total$YearRemodAdd-total$YearBuilt #Normalizo y penalizo total$Antiguedad<-normalize(total$Antiguedad) total$Penaliza<-normalize(total$Penaliza) total$Antiguedad<-total$Antiguedad+total$Penaliza*0.1 #Borro las variables auxiliares Remodelado y Penaliza total$Remodelado<-NULL total$Penaliza<-NULL #Vemos correlacion nueva variable Antiguedad cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete") ``` ```{r} #Recargamos los datos NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) ``` *** Creo una columna donde pongo este calculo Como la antiguedad la tenemos en enteros y para ser justo con la penalizacion voy a normalizar las variables Luego le aplicare un 10% de la antigüedad de la remodelación a la antigüedad de la vivienda
La correlacion de Antiguedad es de **`r cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")`** Partiamos de una correlacion de Año Construccion de **`r cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")`** y en Año Remodelacion de **`r cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")`** Nos hemos acercado a la mas alta pero reduciendo a la mitad el numero de variables 4. GARAGEYRBUILT {.storyboard data-navmenu="2 PREPARACION"} ==== ### Eliminamos los valores igual a 0, o sea que no tienen garaje. Ya comprobamos anteriormente la congruencia de los registros. Vemos gráficamente ```{r} GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0) garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt)) garage<-garage+geom_histogram(fill='blue') garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma) garage ``` *** Tenemos un outlier. Corresponde al registro 2593. ### Vamos a ver los datos pertinentes y modificamos ```{r} kable(total%>%filter(Id==2593)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars,YearBuilt,YearRemodAdd,YrSold))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` ```{r echo=TRUE} total[2593,60]<-2007 ``` *** Podemos inferir que el año real de construcción del garaje es 2007 y no 2207. ### Recalculamos y volvemos a observar ```{r } #Recalcular NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) #Visualizacion total GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0) garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt)) garage<-garage+geom_histogram(fill='blue') garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma) garage ``` ### Verifico que el año de construcción del Garage sea posterior al de la casa. Ponemos el año como el de la vivienda en los que no lo sea ```{r } GarageTOTAno$dif<-GarageTOTAno$GarageYrBlt-GarageTOTAno$YearBuilt kable(GarageTOTAno%>%filter(dif<0)%>%select(Id,YearBuilt,GarageYrBlt))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` ```{r echo=TRUE} total$GarageYrBlt[(total$GarageYrBlt%filter(is.na(SalePrice)==FALSE) ``` *** Hay 18 registros que tienen el año de construccion del garage anterior al de la vivienda. Entiendo que se debe a errores tipográficos, como confundir un 4 por un 9 o diferencias pequeñas de tiempo que hacen variar en un año ### Veamos la relación con el precio ```{r collapse=TRUE} #Visualizar train. Eliminamos los que no tienen garaje GarageAno<-TrainNum%>%filter(GarageYrBlt!=0) garage1<-ggplot() garage1<-garage1+geom_point(data=GarageAno,aes(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice)) garage1<-garage1+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma) garage1 ``` *** Podemos pensar que parece existir una relación. ### Numericamente ```{r echo=TRUE} cor(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice,method="spearman",use="na.or.complete") ``` *** Hay que tener en cuenta que no he incluido los registros que no tienen garaje. Si se les incluye, curiosamente la correlacion aumenta. ### De todas formas es interesante realizar como con la variable anterior, calcular la antigüedad ```{r echo=TRUE} #Calculo antiguedad Garaje total$AntGarage<-total$YrSold-total$GarageYrBlt #Recalculo NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) #Correlacion cor(x=TrainNum$AntGarage,y=TrainNum$SalePrice,method="spearman",use="na.or.complete") ``` ### Y graficamente ```{r} garage2<-ggplot() garage2<-garage2+geom_point(data=TrainNum,aes(x=TrainNum$AntGarage,y=TrainNum$SalePrice)) garage2<-garage2+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma) garage2 ``` *** Todo el grupo de observaciones que se ve a la derecha son aquellos que no tienen garage y les sale como antiguedad tanta como el año de venta. Eso les supone una penalizacion **En conclusion para las variables `YearBuilt`, `YearRemodAdd`, `MoSold`, `YrSold` y `GarageYrBlt` nos quedamos con `Antigüedad` y `AntGarage` como variables importantes para el precio de venta** 5. REVISION RESTO CUANTITATIVAS {.storyboard data-navmenu="2 PREPARACION"} ========== ### Primero la correlacion de las variables entre si, sin contar con el precio ni las variables ya tratadas {vertical_layou=scroll} ```{r collapse=TRUE} TotalNum.noprice<-TotalNum%>%select(-Id,-SalePrice,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt ) #Matriz correlaciones CorrNum<-cor(TotalNum.noprice,method = 'spearman') #Valores absolutos CorrNum.abs<-as.data.frame(abs(CorrNum)) #Pongo a 0 los 1 para encontrar el maximo CorrNum.abs[which(CorrNum.abs==1,arr.ind = TRUE)]<-0 #Busco el valor maximo de correlacion en cada variable ahora CorrNum.inf<-apply(CorrNum.abs,2,max) #Elimino las filas y columnas con correlacion baja CorrNum.max<-CorrNum.abs[-(which(CorrNum.inf<0.5)),-(which(CorrNum.inf<0.5))] #Pongo a 0 los valores inferiores a 0.5 CorrNum.max[which(CorrNum.max<0.5,arr.ind = TRUE)]<-0 CorrNum.max<-as.matrix(CorrNum.max) corrplot(CorrNum.max,order = 'hclust',hclust.method = 'ward.D2',sig.level = 0.5,tl.col = 'black',tl.cex = 0.8,tl.srt = 45,addrect = 14,diag = FALSE) ``` *** Se ve claramente dependencia en ciertos grupos de variables.



















### Antes de seguir vamos a ver la correlacion de las variable significativas (superior a 0.5 en términos absolutos) respecto al Precio ```{r collapse=TRUE} #CORRELACION CON PRECIO TrainNum.price<-TrainNum%>%select(-Id,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt ) #Matriz correlaciones CorrPri<-cor(TrainNum.price,method = 'spearman') CorrPri.abs<-as.data.frame(CorrPri) #Pongo a 0 los 1 para encontrar el maximo CorrPri.abs[which(CorrPri.abs==1,arr.ind = TRUE)]<-0 #Busco el valor maximo de correlacion en cada variable ahora CorrPri.inf<-apply(CorrPri.abs,2,max) #Busco el valor minimo de correlacion en cada variable ahora CorrPri.sup<-apply(CorrPri.abs,2,min) #Elimino las filas y columnas con correlacion baja CorrPri.max<-CorrPri.abs[-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5)),-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5))] #Pongo a 0 los valores inferiores a 0.5 y superiores a -0.5 CorrPri.max[which((CorrPri.max<0.5 & CorrPri.max>-0.5),arr.ind = TRUE)]<-0 CorrPri.max<-as.matrix(CorrPri.max) #Reordenamos por FPC Orden.fpc<-corrMatOrder(CorrPri.max,order='FPC') #Primer Componente principal CorrNum.fpc<-CorrPri.max[Orden.fpc,Orden.fpc] #Grafico corrplot(CorrNum.fpc,type='lower',tl.col = 'black',tl.cex = .8,tl.srt = 30) ``` *** En el grafico en la fila inferior tenemos SalePrice. En rojo las variables con correlacion negativa :

AntGarage Antigüedad En azul las variables predictoras con correlacion positiva:

GarageArea GarageCars

Fireplaces FireplaceQu

X1stFlrSF TotalBsmtSF

TotRmsAbvGrd GrLivArea FullBath

GarageFinish

KitchenQual

BsmtQual

ExterQual

OverallQual

Las variables que pongo juntas tienen una correlacion fuerte (ver primer grafico ) entre ellas y cierta explicacion lógica.

6. ANTIGUEDAD y ANTGARAGE {data-navmenu="2 PREPARACION"} ============

Es evidente que tiene una gran correlacion porque en cierta medida su valor crece de manera proporcionada.
Si una vivienda tiene un garaje, la antigüedad del garaje crece de igual manera que la antigüedad de la vivienda y suelen ser iguales salvo que el garaje se haya construido después.
De todas formas no soy partidario de unirlas de alguna forma porque la variable AntGarage tiene la peculiaridad de aquellas viviendas sin garaje que hay que mantener
Solo voy a normalizar la varable AntGarage, puesto que Antigüedad ya lo estaba
```{r echo=TRUE} total$AntGarage<-normalize(total$AntGarage) #Recalculo NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) ```

7. GARAGECARS Y GARAGEAREA {data-navmenu="2 PREPARACION"} =========

A pesar de que tienen relación con otras variables la mas importante es entre ellos, y puede parecer lógico puesto que el numero de coches que pueda entrar en un garaje depende directamente del espacio que este tenga Primero normalizo las variables según función ```{r echo=TRUE} TotalNum$GarageArea<-normalize(TotalNum$GarageArea) TotalNum$GarageCars<-normalize(TotalNum$GarageCars) cor(x=TotalNum$GarageArea,y=TotalNum$GarageCars,method = 'spearman') ```

La relacion es positiva. Ambas tienen una correlacion positiva y parecida con respecto al precio ```{r collapse=TRUE,echo=TRUE} TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) cor(x=TrainNum$GarageArea,y=TrainNum$SalePrice,method = 'spearman') cor(x=TrainNum$GarageCars,y=TrainNum$SalePrice,method = 'spearman') ```

La opcion que opto es multiplicar ambas variables puesto que `GarageCars` es discreta y `GarageArea` es continua. La nueva variable `GARAGETOTAL` se convierte en continua, mantiene la normalización y el valor 0 para los que no tienen garaje ```{r collapse=TRUE, echo=TRUE} TrainNum$Garage2<-TrainNum$GarageArea*TrainNum$GarageCars cor(x=TrainNum$Garage2,y=TrainNum$SalePrice,method = 'spearman') ``` Es una correlacion media de las otras dos.
Normalizo y actualizo ```{r echo=TRUE} total$GarageTotal<-normalize(total$GarageArea)*normalize(total$GarageCars) #Recalculo NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) ```

8. FIREPLACES y FIREPLACEQU {data-navmenu="2 PREPARACION"} =========== Column -------- `Fireplaces` es el numero de chimeneas `FireplacesQu` es la calidad según vimos cuando se paso de categorica a ordinal La correlacion positiva entre ellas nos indica que a medida que el numero de chimeneas aumenta también aumenta la calidad ```{r collapse=TRUE,echo=TRUE} cor(x=total$Fireplaces,y=total$FireplaceQu,method = 'kendall') ```
Con respecto al precio ```{r echo=TRUE} cor(x=TrainNum$FireplaceQu,y=TrainNum$SalePrice,method='spearman') cor(x=TrainNum$Fireplaces,y=TrainNum$SalePrice,method='spearman') ```
La correlacion con el precio no es muy alta y ademas la correlacion entre ellas es altisima, por lo que me quedo con una y descarto la otra Me quedo con `FireplaceQu`. Y la normalizo ```{r echo=TRUE} total$FireplaceQu<-normalize(total$FireplaceQu) ``` ```{r} #Recalculo NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) ``` Column ----------

Ademas es una relacion fuerte. Vemos un grafico

```{r collapse=TRUE} chim<-ggplot(data=TotalNum,aes(x=TotalNum$Fireplaces, y=TotalNum$FireplaceQu)) chim<-chim+geom_count()+labs(x="NUMERO CHIMENEAS",y="CALIDAD CHIMENEAS") chim ```


9. 1STFlRSF y TOTALBSMTSF {.storyboard data-navmenu="2 PREPARACION"} ============ ### La correlacion entre ellos es bastante alta ```{r echo=TRUE} cor(x=total$X1stFlrSF,y=total$TotalBsmtSF,method='spearman') ```

```{r echo=TRUE} summary(total$X1stFlrSF) summary(total$TotalBsmtSF) ``` *** 1stFlrSF corresponde al área del primer piso. TotalBsmtSF es el área del sotano Se presupone que las viviendas que tienen sotano , por lo general el área en planta del sotano es igual que el de la primera planta. La diferencia por lo general esta en que todas las viviendas tienen primera planta, pero no todas tienen sotano ### Vemos un grafico esclarecedor ```{r collapse=TRUE} pru<-ggplot() pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$X1stFlrSF,y=TotalNum$TotalBsmtSF)) pru<-pru+scale_x_continuous(limits=c(0,6150))+scale_y_continuous(limits=c(0,6150)) pru<-pru+labs(x='AREA PRIMER PISO',y='AREA SOTANO') pru ``` *** Se aprecian dos líneas claramente, una siguiendo el eje de abscisas en o que son las viviendas sin sotano y la otra línea de inclinación 45º que son las viviendas que tienen el mismo área de vivienda que de sotano. Hay que destacar que hay unas cuantas viviendas que tienen mas área de sotano que de primer piso ### Vemos su correlacion con el precio ```{r echo=TRUE} cor(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice,method='spearman') cor(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice,method='spearman') ``` *** No parece que haya una correlacion muy alta . ### Vemos la corelacion con el precio gráficamente ```{r collapse=TRUE} pru<-ggplot() pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice),color='red') pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice),color='blue') pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma) pru ``` ### Tenemos dos outliers en la esquina inferior derecha. Les busco y excluyo estos valores para ver si mejora ```{r } kable(TrainNum%>%filter(X1stFlrSF>3000 & SalePrice<200000)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ```

```{r echo=TRUE} TrainNum.piso<-TrainNum%>%filter(Id!=524)%>%filter(Id!=1299) ``` ### Vemos de nuevo ```{r collapse=TRUE} pru<-ggplot() pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='red') pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice),color='blue') pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma) pru ``` *** ### El grafico parece que ha mejorado. Veamos numéricamente ```{r echo=TRUE} cor(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice,method='spearman') cor(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice,method='spearman') ```

```{r echo=TRUE} #Separo las viviendas por el sotano TrainNum.sot<-TrainNum%>%filter(TotalBsmtSF==0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice) TrainNum.piso<-TrainNum%>%filter(TotalBsmtSF>0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice) ``` *** Sí hay mejoria pero no parece significativa. En principio no descarto estos registros por si afectan a otras variables Voy a separar en la variable de área de primera planta a las viviendas que tienen sotano y las que no ### Vemos graficamente ```{r collapse=TRUE} pru<-ggplot() pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='blue',alpha=0.1) pru<-pru+geom_point(data=TrainNum.sot,aes(x=TrainNum.sot$X1stFlrSF,y=TrainNum.sot$SalePrice),color='red',alpha=0.3) pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma) pru ``` ```{r} TrainNum$AreaPiso<-TrainNum$X1stFlrSF+TrainNum$TotalBsmtSF ``` *** Se aprecia que las vivendas sin sotano (puntos rojos) por lo general están penalizadas en el precio, casi todas están en la parte baja de la nube. En mi opinión se debería combinar ambas variables pero que penalizen a las viviendas sin sotano, parecido a lo que sucedia a la penalizacion en la antigüedad. Para eso voy a sumar el área del sotano y el de la primera planta La mayoría de las viviendas verán casi doblada su superficie, pero las viviendas sin sotano se quedan como están ### Vemos graficamente ```{r collapse=TRUE} pru<-ggplot() pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$AreaPiso,y=TrainNum$SalePrice),color='blue',alpha=0.2) pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma) pru ``` ### Numericamente ```{r collapse=TRUE} cor(x=TrainNum$AreaPiso,y=TrainNum$SalePrice,method='spearman') ```

```{r echo=TRUE} total$AreaPiso<-normalize(total$X1stFlrSF+total$TotalBsmtSF) #Recalculo NNum<-which(sapply(total,is.numeric)) TotalNum<-total[,NNum] TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) ``` *** La correlacion mejora La distribución parece bastante parecida. Dejamos asi la nueva variable y la normalizamos 10. GRLIVAREA FULLBATH TOTRMSABVGRD {.storyboard data-navmenu="2 PREPARACION"} ================ ### Vemos la correlacion entre las tres ```{r collapse=TRUE} kable(cor(total%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` *** Estas variables corresponde a

GrLivArea pies cuadrados del área habitable sobre el nivel del suelo

FullBath baños completos por encima del suelo

TotRmsAbvGrd Total de habitaciones por encima del suelo (no incluye baños) Parece evidente una relación lógica entre la primera variable y las otras dos ### Graficamente ```{r collapse=TRUE} pru<-ggplot() pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$TotRmsAbvGrd,y=TotalNum$GrLivArea),color='blue',alpha=0.1) pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$GrLivArea),color='red',alpha=0.3) pru<-pru+labs(x='Estancias ',y='Area')+scale_y_continuous(labels = scales::comma) pru ``` *** En rojo el numero de baños y en azul el total de estancias por encima del nivel del suelo. Todo en funcion del precio de venta de la casa ### Tenemos dos outliers que con un area habitable superior a 5000 y con 12 y 15 habitaciones solo tiene 2 baños ```{r collapse=TRUE} TotalNum.sala<-TotalNum kable(TotalNum%>%filter(FullBath==2 & GrLivArea>5000)%>%select(Id,GrLivArea,FullBath,TotRmsAbvGrd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=11,position = 'center') ``` ```{r collapse=TRUE} print ("Correlacion sin outliers") TotalNum.sala<-TotalNum.sala%>%filter(Id!=1299)%>%filter(Id!=2550) kable(cor(TotalNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=11,position = 'center') ``` ```{r collapse=TRUE} print ("Correlacion con outliers") kable(cor(total%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=11,position = 'center') ``` *** Les descarto y compruebo como queda la matriz de correlacion Parece que incluso ha empeorado con respecto al anterior (se muestra mas abajo) ### Pero voy a verlo teniendo en cuenta el precio ```{r collapse=TRUE} TrainNum.sala<-TotalNum.sala%>%filter(is.na(SalePrice)==FALSE) #Correlacion con outliers print ("Correlacion con outliers") kable(cor(TrainNum%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'lawngreen') #Correlacion sin outliers print ("Correlacion sin outliers") kable(cor(TrainNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'lawngreen') ``` *** Se puede observar como al quitar los outliers la correlacion entre las variables que estudiamos empeoran pero mejoran todas con respecto al precio. Lo dejamos en recordatorio como los otros outliers que hemos visto para más adelante ### Podemos pensar que si consideramos los baños como una estancia mas podemos unirlo en una sola variable ```{r collapse=TRUE} #Si se suman los baños y las estancias #¿No tienen baño? kable(TotalNum%>%filter(FullBath==0)%>%select(Id,HalfBath,BsmtFullBath,BsmtHalfBath))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` *** **Pregunta**: ¿Qué significa que haya viviendas que no tengan baño? **Respuesta**: Que tienen medios baños o baños en el sotano En la tabla las casas que no tienen baño ### Esta es la grafica de la relación entre los baños y el precio ```{r collapse=TRUE,message=FALSE,warnings=FALSE} pru<-ggplot() pru<-pru+geom_boxplot(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$SalePrice,group=TotalNum$FullBath),color='red') pru<-pru+labs(x='Baños ',y='Precio')+scale_y_continuous(labels = scales::comma) pru ``` *** Las vivendas sin baño están penalizadas en el precio aunque no demasiado ### Si sumamos los baños como una `estancia` mas ```{r echo=TRUE} #Sumamos los baños TotalNum$estancias<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd ``` ```{r} kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` *** Evidentemente la correlacion con las variables que la componen tiene que ser alta, pero con el area habitable mejora bastante la correlacion individual mejor que tenia antes La correlacion de `GrLivArea` con `FullBath` es `r cor(x=TotalNum$GrLivArea,y=TotalNum$FullBath,method='spearman')` y con `TotRmsAbvGrd` es `r cor(x=TotalNum$GrLivArea,y=TotalNum$TotRmsAbvGrd,method='spearman')` Con la nueva variable `estancias` es `r cor(x=TotalNum$GrLivArea,y=TotalNum$estancias,method='spearman')` ### Voy a sumarle también los medios baños pero reducido a la mitad en su valor ```{r echo=TRUE} #Sumamos los medios baños TotalNum$estancias2<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd+(TotalNum$HalfBath/2) ``` ```{r} kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,estancias2),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'yellow')%>%row_spec(5,background = 'lawngreen') ``` *** Aunque empeora la correlacion con las otras variables, mejora con el area habitable que es con la que voy a combinarla y normalizarlas ### Combino todo y normalizo ```{r echo=TRUE} #Combinar con area habitable y normalizar TotalNum$Habitat<-normalize(TotalNum$estancias2*TotalNum$GrLivArea) #Comparamos con precio TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE) ``` ```{r} kable(cor(TrainNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,Habitat,SalePrice),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'yellow')%>%row_spec(5,background = 'lawngreen') ``` ```{r echo=TRUE} #Crear variable y normalizar total$Habitat<-normalize((total$FullBath+total$TotRmsAbvGrd+(total$HalfBath/2))*total$GrLivArea) ``` *** Como el numero de estancias es *cuasidiscreto* (por tener medios baños) y el area habitable es continuo multiplico ambos para obtener una nueva variable `Habitat` continua La nueva variable esta mucho mas correlacionada con las tres variables originales y además se acerca bastante a la variable original de mayor correlacion con el precio Creamos en dataset conjunto y normalizamos

11. NORMALIZACION DE RESTO DE VARIABLES {data-navmenu="2 PREPARACION"} =============

GarageFinish acabado interior del garaje

KitchenQual calidad de la cocina

BsmtQual Altura del sótano

ExterQual calidad del material exterior

OverallQual material general y calidad de acabado

Son todas variables ordinales que indican distintos acabados/calidades de la vivienda Es razonable pensar que junto con otras variables que no aparecen por no estar tan relacionadas, mantengan una correspondencia al nivel general de calidad de la vivienda y este está asociado al precio de manera importante. En mi opinión no tiene justificación lógica el combinar varias de estas variables puesto que no tienen una relación causal a pesar de que tengan una correlacion importante Las normalizamos ```{r echo=TRUE} total$GarageFinish<-normalize(total$GarageFinish) total$KitchenQual<-normalize(total$KitchenQual) total$BsmtQual<-normalize(total$BsmtQual) total$ExterQual<-normalize(total$ExterQual) total$OverallQual<-normalize(total$OverallQual) ``` 12. CONCLUSION {data-navmenu="2 PREPARACION"} ===========

De todas las variables cuantitativas nos quedamos con las siguientes:

Antiguedad AntGaraje GarageTotal FirePlaceQu AreaPiso Habitat GarageFinish KitchenQual BsmtQual ExterQual OverallQual

De un total de 51 variables numéricas del dataset (excluyendo la identificación `Id` y el precio de venta `SalePrice`) hemos reducido las variables predictoras a 11

1. TIPOFACTORES { data-navmenu="3 PREPARACION"} ========== Column {.tabset} ----------- ### CONDICIONES PREVIAS El paquete `FactoMineR` tiene varias opciones interesantes para realizar distintas métodos de analisis de datos y entre ellos tiene un método llamado `condes()` que sirve para describir una variable continua en función de variables continuas y/o categóricas

```{r collapse=TRUE} #Columnas con valores categoricos NFact<-which(sapply(total,is.factor)) TotalFact<-total[,NFact] #Añado variables numericas Id y SalePrice TotalFact$Id<-total$Id TotalFact$SalePrice<-total$SalePrice TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE) ``` ```{R echo=TRUE} #Buscamos categorias mas proximas a SalePrice options(digits=12) fact1<-condes(TrainFact,num.var = 30) ```
Esto nos genera una lista de tres elementos (como maximo) * Una matriz con las variables cualitativas ordenadas por `R²` * Una matriz con las variables cuantitativas ordenadas por correlacion * Una matriz con los coeficientes de cada categoría de las variables cualitativas que cumplen con el `p-value` asignado
Nuestro interés esta en la primera matriz.

Teniendo en cuenta que para la selección de las variables cuantitativas significativas poníamos como criterio que la correlacion debía ser superior a 0.5, entonces en este caso `R²` > (0.5)²=0.25 .

Ese es el limite que ponemos ### VARIABLES
Estas son las variables ```{r echo=TRUE} #Estas son las variables fact1.cuali<-as.data.frame(fact1[[1]]) ``` ```{r} kable(fact1.cuali)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` ### RESUMEN Si vemos las variables solo hay dos que superan un **`R²`** de 0.25, pero teniendo en cuenta que como en las variables numéricas no había normalidad y para la correlacion use el método de Spearman que suele dar un valor ligeramente superior al de Pearson, en este caso voy a escoger también las dos variables que se han quedado a las puertas con 0.24

En resumen :

`Neighborhood` ubicaciones físicas dentro de los límites de la ciudad de Ames Tiene 25 categorias

`MSSubClass` la clase de construcción. Tiene 16 categorias

`Foundation` tipo de cimientos. Tiene 6 categorias

`GarageType` ubicación del garaje Tiene 7 categorias
Son un total de 54 categorias. Si usamos *one hot encoding* suponen `(25-1)+(16-1)+(6-1)+(7-1)=50` nuevas variables a añadir a las 11 numericas que ya tenemos. Hay que reducirlas Las revisamos 2. NEIGHBORHOOD (Vecindario){.storyboard data-navmenu="3 PREPARACION"} =============== ### Esta variable tiene 25 categorias. Veamos grafica y ordenadamente por la media ```{r collapse=TRUE} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue') pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean) pru<-pru+labs(x='Barrio',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones ### Veamos grafica y ordenadamente por la mediana ```{r collpse=TRUE} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen') pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median) pru<-pru+labs(x='Barrio',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones Voy a intentar reducir las variables. Para eso voy a utilizar una clasificación jerarquica aglomerativa sencilla mediante `hclust` Voy a realizar varias clasificaciones y recalcular el coeficiente de determinación que quedaria antes de decidir . Los clusters que elegimos van de 3 a 8 agrupaciones Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones) ### Dendograma segun medias ```{r fig.width=14,collapse=TRUE,message=FALSE,warning=FALSE} #Preparacion Resultados.vecinos<-matrix(ncol=3) #MATRICES DE RESULTADOS #Prueba clusterizacion medias #Obtencion de los datos train.prueba<-TrainFact%>%group_by(Neighborhood) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$Neighborhood #clusterizacion y guarda de informacion train.hcl<-hclust(dist(train.prueba2)) ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=3)) train.dat[,3]<-paste0('Barrio',cutree(train.hcl,k=4)) train.dat[,4]<-paste0('Barrio',cutree(train.hcl,k=5)) train.dat[,5]<-paste0('Barrio',cutree(train.hcl,k=6)) train.dat[,6]<-paste0('Barrio',cutree(train.hcl,k=7)) train.dat[,7]<-paste0('Barrio',cutree(train.hcl,k=8)) #Se crean nuevas columnas con los clusters calculados TrainFact$NeighborhoodMean1<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMean1)<- train.dat[,2] TrainFact$NeighborhoodMean2<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMean2)<- train.dat[,3] TrainFact$NeighborhoodMean3<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMean3)<- train.dat[,4] TrainFact$NeighborhoodMean4<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMean4)<- train.dat[,5] TrainFact$NeighborhoodMean5<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMean5)<- train.dat[,6] TrainFact$NeighborhoodMean6<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMean6)<- train.dat[,7] ``` ### Dendograma segun medianas ```{r fig.width=14,collapse=TRUE,message=FALSE,warning=FALSE} #Prueba clusterizacion medianas #Obtencion de los datos train.prueba3<-TrainFact%>%group_by(Neighborhood) train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice)) rownames(train.prueba4)<-train.prueba4$Neighborhood #clusterizacion y guarda de informacion train.hcl2<-hclust(dist(train.prueba4)) ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat2<-rownames(train.prueba4) train.dat2<-as.data.frame(train.dat2) train.dat2[,2]<-paste0('Barrio', cutree(train.hcl2,k=3)) train.dat2[,3]<-paste0('Barrio', cutree(train.hcl2,k=4)) train.dat2[,4]<-paste0('Barrio',cutree(train.hcl2,k=5)) train.dat2[,5]<-paste0('Barrio',cutree(train.hcl2,k=6)) train.dat2[,6]<-paste0('Barrio',cutree(train.hcl2,k=7)) train.dat2[,7]<-paste0('Barrio', cutree(train.hcl2,k=8)) #Se crean nuevas columnas con los clusters calculados TrainFact$NeighborhoodMedian1<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMedian1)<- train.dat2[,2] TrainFact$NeighborhoodMedian2<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMedian2)<- train.dat2[,3] TrainFact$NeighborhoodMedian3<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMedian3)<- train.dat2[,4] TrainFact$NeighborhoodMedian4<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMedian4)<- train.dat2[,5] TrainFact$NeighborhoodMedian5<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMedian5)<- train.dat2[,6] TrainFact$NeighborhoodMedian6<-TrainFact$Neighborhood levels(TrainFact$NeighborhoodMedian6)<- train.dat2[,7] #Presentacion resultados Resultados.vecinos<-cbind(c(3,4,5,6,7,8,'Todos')) Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.vecinos<-as.data.frame(Resultados.vecinos) colnames(Resultados.vecinos)<-c('Numero clusters','R2 Media','R2 Mediana') ``` 3. FOUNDATION (Cimientos){.storyboard data-navmenu="3 PREPARACION"} ========== ### Esta variable tiene 6 categorias. Veamos grafica y ordenadamente por la media ```{r collapse=TRUE} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue') pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean) pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones ### Veamos grafica y ordenadamente por la mediana ```{r collpse=TRUE} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen') pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median) pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones Realizamos la misma operación que con el vecindario, solo que aquí tenemos 6 grupos por lo que los cluster que elegimos van de 2 a 5 Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones) ### Dendograma segun medias ```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE} #Preparacion Resultados.cimientos<-matrix(ncol=3) #MATRICES DE RESULTADOS #Prueba clusterizacion medias #Obtencion de los datos train.prueba<-TrainFact%>%group_by(Foundation) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$Foundation #clusterizacion y guarda de informacion train.hcl<-hclust(dist(train.prueba2)) ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Cimiento',cutree(train.hcl,k=2)) train.dat[,3]<-paste0('Cimiento',cutree(train.hcl,k=3)) train.dat[,4]<-paste0('Cimiento',cutree(train.hcl,k=4)) train.dat[,5]<-paste0('Cimiento',cutree(train.hcl,k=5)) #Se crean nuevas columnas con los clusters calculados TrainFact$FoundationMean1<-TrainFact$Foundation levels(TrainFact$FoundationMean1)<- train.dat[,2] TrainFact$FoundationMean2<-TrainFact$Foundation levels(TrainFact$FoundationMean2)<- train.dat[,3] TrainFact$FoundationMean3<-TrainFact$Foundation levels(TrainFact$FoundationMean3)<- train.dat[,4] TrainFact$FoundationMean4<-TrainFact$Foundation levels(TrainFact$FoundationMean4)<- train.dat[,5] ``` ### Dendograma segun medianas ```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE} #Prueba clusterizacion medianas #Obtencion de los datos train.prueba3<-TrainFact%>%group_by(Foundation) train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice)) rownames(train.prueba4)<-train.prueba4$Foundation train.hcl2<-hclust(dist(train.prueba4)) ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat2<-rownames(train.prueba4) train.dat2<-as.data.frame(train.dat2) train.dat2[,2]<-paste0('Cimiento', cutree(train.hcl2,k=2)) train.dat2[,3]<-paste0('Cimiento',cutree(train.hcl2,k=3)) train.dat2[,4]<-paste0('Cimiento',cutree(train.hcl2,k=4)) train.dat2[,5]<-paste0('Cimiento',cutree(train.hcl2,k=5)) #Se crean nuevas columnas con los clusters calculados TrainFact$FoundationMedian1<-TrainFact$Foundation levels(TrainFact$FoundationMedian1)<- train.dat2[,2] TrainFact$FoundationMedian2<-TrainFact$Foundation levels(TrainFact$FoundationMedian2)<- train.dat2[,3] TrainFact$FoundationMedian3<-TrainFact$Foundation levels(TrainFact$FoundationMedian3)<- train.dat2[,4] TrainFact$FoundationMedian4<-TrainFact$Foundation levels(TrainFact$FoundationMedian4)<- train.dat2[,5] #Presentacion resultados Resultados.cimientos<-cbind(c(2,3,4,5,'Todos')) Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.cimientos<-as.data.frame(Resultados.cimientos) colnames(Resultados.cimientos)<-c('Numero clusters','R2 Media','R2 Mediana') ``` 4. GARAGETYPE (Ubicacion del garage){.storyboard data-navmenu="3 PREPARACION"} =========== ### Esta variable tiene 7 categorias. Veamos grafica y ordenadamente por la media y la mediana ```{r collapse=TRUE} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue') pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean) pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones ### Veamos grafica y ordenadamente por la mediana ```{r} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen') pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median) pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones Realizamos la misma operación que con el vecindario, solo que aquí tenemos 7 grupos por lo que los cluster que elegiremos van de 2 a 5 Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones) ### Dendograma segun medias ```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE} #Preparacion Resultados.garage<-matrix(ncol=3) #MATRICES DE RESULTADOS #Prueba clusterizacion medias #Obtencion de los datos train.prueba<-TrainFact%>%group_by(GarageType) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$GarageType #clusterizacion y guarda de informacion train.hcl<-hclust(dist(train.prueba2)) ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('garage',cutree(train.hcl,k=2)) train.dat[,3]<-paste0('garage',cutree(train.hcl,k=3)) train.dat[,4]<-paste0('garage',cutree(train.hcl,k=4)) train.dat[,5]<-paste0('garage',cutree(train.hcl,k=5)) #Se crean nuevas columnas con los clusters calculados TrainFact$GarageTypeMean1<-TrainFact$GarageType levels(TrainFact$GarageTypeMean1)<- train.dat[,2] TrainFact$GarageTypeMean2<-TrainFact$GarageType levels(TrainFact$GarageTypeMean2)<- train.dat[,3] TrainFact$GarageTypeMean3<-TrainFact$GarageType levels(TrainFact$GarageTypeMean3)<- train.dat[,4] TrainFact$GarageTypeMean4<-TrainFact$GarageType levels(TrainFact$GarageTypeMean4)<- train.dat[,5] ``` ### Dendograma segun medianas ```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE} #Prueba clusterizacion medianas #Obtencion de los datos train.prueba3<-TrainFact%>%group_by(GarageType) train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice)) rownames(train.prueba4)<-train.prueba4$GarageType #clusterizacion y guarda de informacion train.hcl2<-hclust(dist(train.prueba4)) ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat2<-rownames(train.prueba4) train.dat2<-as.data.frame(train.dat2) train.dat2[,2]<-paste0('garage', cutree(train.hcl2,k=2)) train.dat2[,3]<-paste0('garage',cutree(train.hcl2,k=3)) train.dat2[,4]<-paste0('garage',cutree(train.hcl2,k=4)) train.dat2[,5]<-paste0('garage',cutree(train.hcl2,k=5)) #Se crean nuevas columnas con los clusters calculados TrainFact$GarageTypeMedian1<-TrainFact$GarageType levels(TrainFact$GarageTypeMedian1)<- train.dat2[,2] TrainFact$GarageTypeMedian2<-TrainFact$GarageType levels(TrainFact$GarageTypeMedian2)<- train.dat2[,3] TrainFact$GarageTypeMedian3<-TrainFact$GarageType levels(TrainFact$GarageTypeMedian3)<- train.dat2[,4] TrainFact$GarageTypeMedian4<-TrainFact$GarageType levels(TrainFact$GarageTypeMedian4)<- train.dat2[,5] #Presentacion resultados Resultados.garage<-cbind(c(2,3,4,5,'Todos')) Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.garage<-as.data.frame(Resultados.garage) colnames(Resultados.garage)<-c('Numero clusters','R2 Media','R2 Mediana') ``` 5. MSSUBCLASS (CLase de construccion){.storyboard data-navmenu="3 PREPARACION"} =========== ### Esta variable tiene 16 categorias. Veamos grafica y ordenadamente por la media ```{r collapse=TRUE} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue') pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean) pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones ### Veamos grafica y ordenadamente por la mediana ```{r} pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice)) pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen') pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median) pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma) pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3)) pru ``` *** En cada columna aparecen las observaciones Esta variable es mas peculiar. Veamosla mas detenidamente ### Vemos sus categorías y apariciones ```{r collapse=TRUE} kable(table(TrainFact$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(13,background = "yellow") ``` *** Tenemos una categoria con 0 casos en el `Train` ### Buscamos en el dataset `Test` ```{r collapse=TRUE} TestFact<-TotalFact%>%filter(is.na(SalePrice)==TRUE) kable(table(TestFact$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(13,background = 'lawngreen') ``` `Id` del nivel buscado ```{r} TestFact%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id) ``` *** Tiene 1 caso, luego no se puede eliminar directamente de todo el conjunto, pero si debemos **NO** tomarlo en consideracion para la reduccion de variables porque si no trastornaria todos los calculos ### Descarto este `level` para el calculo ```{r collapse=TRUE} #Descarto este level para el calculo TrainFact$MSSubClass<-droplevels(TrainFact$MSSubClass,exclude='1-1/2 STORY PUD - ALL AGES') kable(table(TrainFact$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` *** Podemos ver que ya no figura

Realizamos la misma operación que con el vecindario, solo que aquí tenemos 16 (15 con la que no tratamos transitoriamente) grupos por lo que los cluster que elegiremos van de 3 a 8 Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones) ### Dendograma segun medias ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.width=14} #Preparacion Resultados.clases<-matrix(ncol=3) #MATRICES DE RESULTADOS #Prueba clusterizacion medias #Obtencion de los datos train.prueba<-TrainFact%>%group_by(MSSubClass) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$MSSubClass #clusterizacion y guarda de informacion train.hcl<-hclust(dist(train.prueba2)) ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=3)) train.dat[,3]<-paste0('Clase',cutree(train.hcl,k=4)) train.dat[,4]<-paste0('Clase',cutree(train.hcl,k=5)) train.dat[,5]<-paste0('Clase',cutree(train.hcl,k=6)) train.dat[,6]<-paste0('Clase',cutree(train.hcl,k=7)) train.dat[,7]<-paste0('Clase',cutree(train.hcl,k=8)) #Se crean nuevas columnas con los clusters calculados TrainFact$MSSubClassMean1<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMean1)<- train.dat[,2] TrainFact$MSSubClassMean2<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMean2)<- train.dat[,3] TrainFact$MSSubClassMean3<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMean3)<- train.dat[,4] TrainFact$MSSubClassMean4<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMean4)<- train.dat[,5] TrainFact$MSSubClassMean5<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMean5)<- train.dat[,6] TrainFact$MSSubClassMean6<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMean6)<- train.dat[,7] ``` ### Dendograma segun medianas ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.width=14} #Prueba clusterizacion medianas #Obtencion de los datos train.prueba3<-TrainFact%>%group_by(MSSubClass) train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice)) rownames(train.prueba4)<-train.prueba4$MSSubClass #clusterizacion y guarda de informacion train.hcl2<-hclust(dist(train.prueba4)) ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black') train.dat2<-rownames(train.prueba4) train.dat2<-as.data.frame(train.dat2) train.dat2[,2]<-paste0('Clase', cutree(train.hcl2,k=3)) train.dat2[,3]<-paste0('Clase',cutree(train.hcl2,k=4)) train.dat2[,4]<-paste0('Clase',cutree(train.hcl2,k=5)) train.dat2[,5]<-paste0('Clase',cutree(train.hcl2,k=6)) train.dat2[,6]<-paste0('Clase',cutree(train.hcl2,k=7)) train.dat2[,7]<-paste0('Clase',cutree(train.hcl2,k=8)) #Se crean nuevas columnas con los clusters calculados TrainFact$MSSubClassMedian1<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMedian1)<- train.dat2[,2] TrainFact$MSSubClassMedian2<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMedian2)<- train.dat2[,3] TrainFact$MSSubClassMedian3<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMedian3)<- train.dat2[,4] TrainFact$MSSubClassMedian4<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMedian4)<- train.dat2[,5] TrainFact$MSSubClassMedian5<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMedian5)<- train.dat2[,6] TrainFact$MSSubClassMedian6<-TrainFact$MSSubClass levels(TrainFact$MSSubClassMedian6)<- train.dat2[,7] #Presentacion resultados Resultados.clases<-cbind(c(3,4,5,6,7,8,'Todos')) Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]])) Resultados.clases<-as.data.frame(Resultados.clases) colnames(Resultados.clases)<-c('Numero clusters','R2 Media','R2 Mediana') ``` 6. CONCLUSIONES{.storyboard data-navmenu="3 PREPARACION"} ============== ### CRITERIOS ```{r collapse=TRUE} #Añado la diferencia en columna options(digits=8) Resultados.cimientos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.cimientos$`R2 Media`))[Resultados.cimientos$`R2 Media`]-as.numeric(levels(Resultados.cimientos$`R2 Mediana`))[Resultados.cimientos$`R2 Mediana`]) Resultados.clases$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.clases$`R2 Media`))[Resultados.clases$`R2 Media`]-as.numeric(levels(Resultados.clases$`R2 Mediana`))[Resultados.clases$`R2 Mediana`]) Resultados.garage$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.garage$`R2 Media`))[Resultados.garage$`R2 Media`]-as.numeric(levels(Resultados.garage$`R2 Mediana`))[Resultados.garage$`R2 Mediana`]) Resultados.vecinos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.vecinos$`R2 Media`))[Resultados.vecinos$`R2 Media`]-as.numeric(levels(Resultados.vecinos$`R2 Mediana`))[Resultados.vecinos$`R2 Mediana`]) ``` He obtenido en las siguientes tablas los coeficientes de determinación de las variables agrupadas en diferentes clusters. Tambien figura el valor del que partíamos bajo el epigrafe `Todos` La idea es optimizar el numero que nos quedaremos teniendo en cuenta que ya tenemos 11 variables numéricas Lo primero mas destacable que se observa es que no hay diferencias tomando la media o la mediana de los precios en la variable `GarageType`. Esto se explica porque el dendograma es idéntico en ambos supuestos. [Aqui](#garagetype-ubicacion-del-garage) se puede ver Lo segundo que destaca es que en la gran mayoría de los supuestos tomar como referencia la media del precio suele ser mejor que hacerlo con la mediana. La diferencia es positiva en la mayoría de los casos. Descartamos trabajar con la mediana Como criterios: * En primer lugar seguir el orden asignado por el coeficiente de determinación general. Tendran preferencias las categorías de `Neighborhood`, sobre el resto, luego `Foundation`, `GarageType` y por ultimo `MSSubClass` * Luego elegir aquel agrupamiento en que el paso a un numero de cluster menor suponga una diferencia muy superior a la que supuso el paso anterior (de un numero de clusters mayor). Veremos todo en una tabla con una vista mas amigable ### NEIGHBORHOOD (Vecindario) ```{r collapse=TRUE} kable(Resultados.vecinos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'yellow')%>%row_spec(3,background = 'lawngreen') ``` *** Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar En este caso son 4 clusters y elegimos **5** ### FOUNDATION (Cimientos) ```{r} kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen') ``` *** Descartamos primero aquellas con un coeficiente muy bajo. Las tacho en naranja. Ese es el minimo En este caso 2 clusters Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar En este caso son 4 clusters y elegimos **5** ### GARAGETYPE (Ubicacion del garage) ```{r} kable(Resultados.garage)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'orange')%>%row_spec(3,background = 'lawngreen') ``` *** Descartamos primero aquellas con un coeficiente muy bajo. Las tacho en naranja. Ese es el minimo En este caso 3 clusters Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar En este caso son 3 clusters. El mismo que techamos en naranja. Elegimos **4** ### MSSubClass (Clase de construccion) ```{r} kable(Resultados.clases)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen') ``` *** Descartamos primero aquellas con un coeficiente muy bajo. Las tacho en naranja. Ese es el minimo En este caso 3 clusters Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar En este caso son 5 clusters. Elegimos **6** ### PRIMERA CONCLUSION Tenemos que la primera elección es : * Vecinos: 5 clusters sobre 25 categorias Correlacion ~0.7312 * Cimientos 5 clusters sobre 6 categorias Correlacion ~0.5061 * Garaje 4 clusters sobre 7 categorias Correlacion~0.4976 * Clases 6 clusters sobre 16 categorias Correlacion ~0.4937

Son un total de 20 categorias.

En las dos ultimas (Garage y Clases ) parece difícil reducir mas sin que haya una perdida importante, y ya están muy al limite.

Quizas podríamos reducir uno o dos mas en Cimientos, pero la cantidad de 31 variables numéricas , entre las originales y las reconvertidas puede ser una buena cifra

Para realizar la actualización recuperamos parte del código con el numero cluster que hemos decidido en `Neighborhood`, `Foundation` y `GarageType`. ```{r message=FALSE,warning=FALSE} #Escojo los agrupamientos #Vecinos 5 clusters train.prueba<-TrainFact%>%group_by(Neighborhood) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$Neighborhood train.hcl<-hclust(dist(train.prueba2)) train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=5)) TotalFact$NeighborhoodMean4<-TotalFact$Neighborhood levels(TotalFact$NeighborhoodMean4)<- train.dat[,2] total$Vecindario<-TotalFact$NeighborhoodMean4 #Cimientos 5 clusters train.prueba<-TrainFact%>%group_by(Foundation) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$Foundation train.hcl<-hclust(dist(train.prueba2)) train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=5)) TotalFact$FoundationMean4<-TotalFact$Foundation levels(TotalFact$FoundationMean4)<- train.dat[,2] total$Cimientos<-TotalFact$FoundationMean4 #Garage 4 clusters train.prueba<-TrainFact%>%group_by(GarageType) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$GarageType train.hcl<-hclust(dist(train.prueba2)) train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Garage',cutree(train.hcl,k=4)) TotalFact$GarageTypeMean3<-TotalFact$GarageType levels(TotalFact$GarageTypeMean3)<- train.dat[,2] total$UbicaGarage<-TotalFact$GarageTypeMean3 ``` ### MODIFICACION EN `MSSUBCLASS`.
Para el caso de la variable `MSSubClass` tenemos que recordar que para hacer la agrupación teníamos una categoría que se encontraba en el dataset `Test` pero no en el `Train`, luego dejamos esa categoría apartada , pero ahora hay que introducirla manualmente en un cluster. Para encontrar en que cluster voy a buscar registros con ciertas variables muy correlacionadas con el objetivo y que se parezcan a las del que buscamos. Voy a usar las variables numéricas `Habitat`, `AreaPiso` y `OverallQual` Primero identificaremos el registro del `Test` ```{r collapse=TRUE} #Clases 6 clusters #TrainFact$MSSubClassMean4 #Busqueda kable(total%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id,AreaPiso,Habitat,OverallQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center') ``` A continuacion escogemos las ventanas de los parametros para el filtrado 0.06<`AreaPiso`<0.12 0.16<`Habitat`<0.18 0.6<`OverallQual`<0.7 ### Filtramos por aproximacion a estas variables ```{r echo=TRUE} prue<-total%>%filter(OverallQual>0.6 & OverallQual<0.7)%>%select(Id,AreaPiso,Habitat,MSSubClass) prue<-prue%>%filter(AreaPiso>0.06 & AreaPiso<0.12) prue<-prue%>%filter(Habitat>0.16 & Habitat<0.18)%>%select(Id,MSSubClass) ``` ```{r} kable(table(prue$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(6,background = 'lawngreen') ``` ```{r message=FALSE,warning=FALSE} #Modificacion train.prueba<-TrainFact%>%group_by(MSSubClass) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$MSSubClass train.hcl<-hclust(dist(train.prueba2)) train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=6)) TotalFact$MSSubClassMean4<-TotalFact$MSSubClass ``` *** Hay 11 registros con campos parecidos, incluido el que buscamos. La gran mayoría 9 tienen en `MSSubClass`-> `2-STORY 1946 & NEWER`. Donde esté esta categoría agrupada pondremos la que nos falta con parte del mismo codigo usado en las variables anteriores ### Modificacion especial Hasta aquí es todo igual en el codigo que en n las variables anteriores. Vamos a buscar en que grupo queda `2-STORY 1946 & NEWER` que es donde hay que meter el nivel de factor que nos falta ```{r collapse=TRUE} #Vemos el que falta y se añade kable(train.dat)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(6,background = 'lawngreen') ```
Es el elemento numero 6 que corresponde al cluster `Clase4` Ademas ```{r echo=TRUE} levels(total$MSSubClass) ```
`1-1/2 STORY PUD - ALL AGES` tiene que ir en la posicion numero 13. La añadiremos como una fila a train.dat desplazando el resto ```{r echo=TRUE} #Añado el level levels(train.dat$train.dat)<-c(levels(train.dat$train.dat),'1-1/2 STORY PUD - ALL AGES') #Añado la fila train.dat<-rbind(train.dat,c('1-1/2 STORY PUD - ALL AGES','Clase4')) #Cojo levels originales como vector lev<-as.vector(levels(total$MSSubClass)) #Comparo y ordeno train.dat<-train.dat[match(lev,train.dat$train.dat),] #Ya estan ordenados los level y los valores que les sutituyen levels(TotalFact$MSSubClassMean4)<-train.dat$V2 total$Clases<-TotalFact$MSSubClassMean4 ```

1. INTRODUCCION {data-navmenu="MODELIZACION"} =========
Para buscar el modelo que mas conviene tomar para realizar la prediccion que se pide voy a dividir el conjunto de predictores en varias partes.

Por un lado aquellos predictores que son desde el origen numéricos y que además son continuos o discretos con un numero amplio de intervalos Son :`Antiguedad`, `AntGarage`, `AreaPiso`, `GarageTotal`, `Habitat` y `OverallQual`

En otro grupo los predictores numéricos de origen ordinal con un numero pequeño de intevalos. Son : `BsmtQual`, `ExterQual`, `FireplaceQu`, `GarageFinish` y `KitchenQual`

En el ultimo grupo los predictores de origen categoricos Son : `Neighborhood`, `Foundation`, `GarageType` y `MSSubClass`

Esta división solo la hago en sentido grafico para apreciar mejor las diversas características

Voy a aplicar un modelo lineal multiple, uno polinómico, otro suavizado tipo Loess y uno suavizado con curvas Spline y vamos a comparar en cada variable con respecto a la objetivo SalePrice

Aunque el grafico es muy completo entre toda las variables solos nos interesa la fila inferior donde aparecen los graficos de cada predictor en función del objetivo

Podemos ver también en las primeras graficas en la columna mas a la derecha el valor de correlacion de SalePrice con el resto de variables

2. NUMERICAS Continuas {.storyboard data-navmenu="MODELIZACION"} ============ ### Vision de conjunto 1
Modelo Lineal (lm)-Cyan
Suavizado Local(Loess)-Rojo ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} #preparacion datos Model1<-total%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual,SalePrice) ModelTrain1<-Model1%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id) GGP1<-ggpairs(ModelTrain1, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo") GGP1<-GGP1+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1)) GGP1 ``` ### Vision de conjunto 2
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} GGP2<-ggpairs(ModelTrain1, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja") GGP2<-GGP2+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1)) GGP2 ``` ### Vision de conjunto 3
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} GGP3<-ggpairs(ModelTrain1, lower = list(continuous = my_rg3), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Verde y Suavizado Local(Loess)-Rojo") GGP3<-GGP3+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1)) GGP3 ``` ### ANTIGUEDAD ```{r collapse=TRUE,message=FALSE,warning=FALSE} #Plots individuales p11<-getPlot(GGP1,7,1) p12<-getPlot(GGP1,7,2) p13<-getPlot(GGP1,7,3) p14<-getPlot(GGP1,7,4) p15<-getPlot(GGP1,7,5) p16<-getPlot(GGP1,7,6) p31<-getPlot(GGP3,7,1) p36<-getPlot(GGP3,7,6) p11<-p11+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p12<-p12+labs(title="AntGarage")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p13<-p13+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p14<-p14+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p15<-p15+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p16<-p16+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p31<-p31+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p36<-p36+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) ``` ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p11 ``` *** Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo Se adapta mejor la curva suavizada que la recta ### ANTIGUEDAD GARAGE (AntGarage) ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p12 ``` *** Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo La especificidad de los datos (como poner antigüedad a los que no tienen garaje) hace que salga una grafica extraña, pero me decanto por el modelo lineal ### AREAPISO ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p13 ``` *** Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo Los outliers hacen que las curvas no sirvan, pero sin ellos podria ser la opcion adecuada ### GARAGETOTAL ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p14 ``` *** Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion ### HABITAT ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p15 ``` *** Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion ### OVERALLQUALL . material general y calidad de acabado ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p16 ``` *** Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo Pasa algo parecido que con la antigüedad. Se adapta mejor una curva ### ANTIGUEDAD: COMPARATIVA DE CURVAS ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p31 ``` *** Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente ### OVERALLQUALL: COMPARATIVA DE CURVAS ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p36 ``` *** Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente 3. NUMERICAS discretas {.storyboard data-navmenu="MODELIZACION"} ============ ### Vision de conjunto 1
Regresion: Modelo Lineal (lm)-Cyan
Suavizado Local(Loess)-Rojo ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=7,fig.width=15} #Preparacion de datos Model2<-total%>%select(Id,BsmtQual,ExterQual,FireplaceQu,GarageFinish,KitchenQual,SalePrice) ModelTrain2<-Model2%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id) GGP4<-ggpairs(ModelTrain2, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo") GGP4<-GGP4+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1)) GGP4 ``` *** El metodo de regresion local `LOESS` no es aceptable en estas variables ### Vision de conjunto 2
Regresion: B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} GGP5<-ggpairs(ModelTrain2, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja") GGP5<-GGP5+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1)) GGP5 ``` ### Vision de conjunto 3
Regresion: Modelo lineal con intervalo de confianza - Purpura ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} GGP6<-ggpairs(ModelTrain2, lower = list(continuous = my_rg4), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo lineal con intervalo de confianza - Purpura") GGP6<-GGP6+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1)) GGP6 ``` ### BSMTQUAL . Altura del sotano ```{r collapse=TRUE,message=FALSE,warning=FALSE} #Plots individuales p51<-getPlot(GGP5,6,1) p52<-getPlot(GGP5,6,2) p53<-getPlot(GGP5,6,3) p54<-getPlot(GGP5,6,4) p55<-getPlot(GGP5,6,5) p51<-p51+labs(title="BsmtQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p52<-p52+labs(title="ExterQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p53<-p53+labs(title="FireplaceQu")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p54<-p54+labs(title="GarageFinish")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p55<-p55+labs(title="KitchenQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) ``` ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p51 ``` *** Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja Se adapta mejor la curva suavizada que la recta ### EXTERQUAL . Calidad del material exterior ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p52 ``` *** Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja Se adapta mejor la curva suavizada que la recta ### FIREPLACEQU . Calidad de la chimenea ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p53 ``` *** Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja No esta tan claro que tipo se adapta mejor. Se vera numericamente ### GARAGEFINISH . Acabado interior del garage ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p54 ``` *** Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja No esta tan claro que tipo se adapta mejor. Se vera numericamente ### KITCHENQUAL . Calidad de la cocina ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p55 ``` *** Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja Se adapta mejor la curva suavizada que la recta 4. CATEGORICAS {.storyboard data-navmenu="MODELIZACION"} ============ ### Vision de conjunto 1
Boxplots ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=7,fig.width=15} #preparacion Model3<-total%>%select(Id,Neighborhood,Foundation,GarageType,MSSubClass,SalePrice) ModelTrain3<-Model3%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id) ModelTrain3$Neighborhood<-reorder(ModelTrain3$Neighborhood,ModelTrain3$SalePrice,FUN = 'mean') ModelTrain3$Foundation<-reorder(ModelTrain3$Foundation,ModelTrain3$SalePrice,FUN = 'mean') ModelTrain3$GarageType<-reorder(ModelTrain3$GarageType,ModelTrain3$SalePrice,FUN = 'mean') ModelTrain3$MSSubClass<-reorder(ModelTrain3$MSSubClass,ModelTrain3$SalePrice,FUN = 'mean') GGP7<-ggpairs(ModelTrain3, lower = list(combo = 'box'), diag = list(continuous = "densityDiag"), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas') GGP7<-GGP7+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1)) GGP7 ``` *** En cuanto a las variables categoricas , no se puede hacer ningún análisis grafico de lineas de regresion por la propia composición de la variable. Si podemos ver una matriz de graficos de sus variables origen ordenadas por la variable destino ### Vision de conjunto 2
Nubes de puntos ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} GGP8<-ggpairs(ModelTrain3, lower = list(combo = 'dot'), diag = list(continuous = "densityDiag",discrete='barDiag'), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas') GGP8<-GGP8+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1)) GGP8 ``` ### Neighborhood . Vecindario ```{r collapse=TRUE,message=FALSE,warning=FALSE} #Plots individuales p81<-getPlot(GGP8,5,1) p82<-getPlot(GGP8,5,2) p83<-getPlot(GGP8,5,3) p84<-getPlot(GGP8,5,4) p81<-p81+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p82<-p82+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p83<-p83+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p84<-p84+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) ``` ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p81 ``` *** Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad ### Foundation . Cimientos ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p82 ``` *** Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad ### GarageType . Ubicacion del garage ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p83 ``` *** Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad ### MSSubClass . Clase de construccion ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p84 ``` *** Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad ### Vemos ahora con la agrupación de clusters y ordenadas ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} #DUMMYS #preparacion Model4<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases,SalePrice) ModelTrain4<-Model4%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id) ModelTrain4$Vecindario<-reorder(ModelTrain4$Vecindario,ModelTrain4$SalePrice,FUN = 'mean') ModelTrain4$Cimientos<-reorder(ModelTrain4$Cimientos,ModelTrain4$SalePrice,FUN = 'mean') ModelTrain4$UbicaGarage<-reorder(ModelTrain4$UbicaGarage,ModelTrain4$SalePrice,FUN = 'mean') ModelTrain4$Clases<-reorder(ModelTrain4$Clases,ModelTrain4$SalePrice,FUN = 'mean') GGP9<-ggpairs(ModelTrain4, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none") GGP9<-GGP9+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1)) GGP9 ``` ```{r collapse=TRUE,message=FALSE,warning=FALSE} #Plots individuales p91<-getPlot(GGP9,5,1) p92<-getPlot(GGP9,5,2) p93<-getPlot(GGP9,5,3) p94<-getPlot(GGP9,5,4) p91<-p91+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p92<-p92+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p93<-p93+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p94<-p94+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) ``` ### Neighborhood . Vecindario
5 clusters ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p91 ``` *** Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias ### Foundation . Cimientos
**5 clusters** ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p92 ``` *** Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
Es posible eliminar un cluster mas en `Cimientos` como se había apuntado, pero ahora se ve mejor ### GarageType . Ubicacion del garage
**4 clusters** ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p93 ``` *** Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias ### MSSubClass . Clase de construccion
**6 clusters** ```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'} p94 ``` *** Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias ### Foundation
Resultados para 3, 4 y 5 clusters ```{r collapse=TRUE,message=FALSE,warning=FALSE} #Revision de cimientos . Reduccion de 5 clusters #Columnas con valores categoricos NFact<-which(sapply(total,is.factor)) TotalFact<-total[,NFact] #Añado variables numericas Id y SalePrice TotalFact$Id<-total$Id TotalFact$SalePrice<-total$SalePrice TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE) #Cimientos 3 y 4 clusters train.prueba<-TrainFact%>%group_by(Foundation) train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice)) rownames(train.prueba2)<-train.prueba2$Foundation train.hcl<-hclust(dist(train.prueba2)) train.dat<-rownames(train.prueba2) train.dat<-as.data.frame(train.dat) train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=3)) train.dat[,3]<-paste0('Cimientos',cutree(train.hcl,k=4)) TotalFact$FoundationMean3<-TotalFact$Foundation TotalFact$FoundationMean4<-TotalFact$Foundation levels(TotalFact$FoundationMean3)<- train.dat[,2] levels(TotalFact$FoundationMean4)<- train.dat[,3] #Carga provisional en dataset total$Cimientos1<-TotalFact$FoundationMean3 total$Cimientos2<-TotalFact$FoundationMean4 ``` ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} #Recarga de informacion Model5<-total%>%select(Id,Cimientos1,Cimientos2,Cimientos,SalePrice) ModelTrain5<-Model5%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id) ModelTrain5$Cimientos1<-reorder(ModelTrain5$Cimientos1,ModelTrain5$SalePrice,FUN = 'mean') ModelTrain5$Cimientos2<-reorder(ModelTrain5$Cimientos2,ModelTrain5$SalePrice,FUN = 'mean') ModelTrain5$Cimientos<-reorder(ModelTrain5$Cimientos,ModelTrain5$SalePrice,FUN = 'mean') GGP10<-ggpairs(ModelTrain5, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none",title='Resultados para cluster de Cimientos: 3 , 4 o 5') GGP10<-GGP10+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1)) GGP10 ``` ### Foundation . Cimientos
**5 clusters** ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p101<-getPlot(GGP10,4,1) p102<-getPlot(GGP10,4,2) p103<-getPlot(GGP10,4,3) p101<-p101+labs(title="Cluster n=3")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p102<-p102+labs(title="Cluster n=4")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p103<-p103+labs(title="Cluster n=5")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p103 ``` ### Foundation . Cimientos
**4 clusters** ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p102 ``` ### Foundation . Cimientos
**3 clusters** ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p101 ``` ### Conclusion ```{r collapse=TRUE} kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(2,background = 'lawngreen') #Se escoge 3 cluster total$Cimientos<-total$Cimientos1 total$Cimientos1<-NULL total$Cimientos2<-NULL ``` *** Graficamente la mejor opcion es n=3. Ademas vimos en la sección anterior que no había tanta diferencia ### Transformación de las categorías de las variables no numéricas en variables `dummy` ```{r echo=TRUE } #Columnas con valores categoricos NFact<-which(sapply(total,is.factor)) TotalFact1<-total[,NFact] #Añado variables numericas Id y SalePrice TotalFact1$Id<-total$Id #Conversion a Dummys Total.dummy.B<-TotalFact1%>%select(Id,B=Vecindario) Total.dummy.C<-TotalFact1%>%select(Id,C=Cimientos) Total.dummy.G<-TotalFact1%>%select(Id,G=UbicaGarage) Total.dummy.N<-TotalFact1%>%select(Id,N=Clases) modelo1.B<-as.data.frame(model.matrix(~.,Total.dummy.B)) modelo1.C<-as.data.frame(model.matrix(~.,Total.dummy.C)) modelo1.G<-as.data.frame(model.matrix(~.,Total.dummy.G)) modelo1.N<-as.data.frame(model.matrix(~.,Total.dummy.N)) modelo1.B$`(Intercept)`<-NULL modelo1.C$`(Intercept)`<-NULL modelo1.G$`(Intercept)`<-NULL modelo1.N$`(Intercept)`<-NULL modelo1<-modelo1.B modelo1<-cbind(modelo1,modelo1.C%>%select(-Id)) modelo1<-cbind(modelo1,modelo1.G%>%select(-Id)) modelo1<-cbind(modelo1,modelo1.N%>%select(-Id)) #Modelo con dummys Cuant<-total%>%select(Antiguedad,AntGarage,AreaPiso,BsmtQual,ExterQual,FireplaceQu,GarageFinish,GarageTotal,Habitat,KitchenQual,OverallQual,SalePrice) modelo1.dummy<-cbind(modelo1,Cuant) #Modelo con variables categoricas Total.dummy<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases) modelo1.Nodummy<-cbind(Total.dummy,Cuant) ```
5. OUTLIERS { .storyboard data-navmenu="MODELIZACION"} =========== ### VALORES YA REVISADOS
Si recordamos encontramos dos valores outliers .

El registro 524 que tenia discordancia entre los años de construcción, remodelación y venta (corregido) y además tenia un precio muy bajo para el área habitable en sotano y primer piso.

Eso mismo le pasaba al registro 1299 que tenia un precio muy bajo para el área habitable y además no tenia proporción entre el área habitable, las habitaciones y los baños

En principio tenia pensado dejarles por que además en común con estos dos teniamos el registro 2550 que tenia discordancia en los años y falta de proporción entre el área habitable, las habitaciones y los baños, y este registro esta en el `Test`, pero he creido mas conveniente eliminarles de los datos

Antes de eliminarlos vamos a comprobar que posición ocupan en las variables numéricas normalizadas porque si son el valor extremo, máximo o minimo , al eliminarlo deberemos volver a normalizar esa variable con el nuevo extremo ### COMPROBACION Y NORMALIZACION ```{r collapse=TRUE} #Vemos valores de variables numericas de los outliers por si hay que volver a normalizar kable(modelo1.Nodummy%>%slice(524)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover")) kable(modelo1.Nodummy%>%slice(1299)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover")) ``` ```{r echo=TRUE} #Eliminacion registros y normalizado AreaPiso en ambos dataset modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=524) modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1299) modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso) modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=524) modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1299) modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso) modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice) ``` *** Tanto `Antigüedad` como `AntGarage` ,y `OverallQuall` tienen varios registros con el mismo valor que el que vamos a eliminar, . Sin embargo en `AreaPiso` el registro 1299 es el máximo. Cuando le eliminemos hay que normalizar de nuevo Realizaremos una comprobacion grafica de las variables mas afectadas por los outliers que vimos en la seccion anterior Afectaban sobre todo a `AreaPiso`, `GarageTotal` y `Habitat`. ### `AreaPiso` antes ```{r collapse=TRUE, echo=FALSE} GGP11<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo") p131<-getPlot(GGP11,4,1) p141<-getPlot(GGP11,4,2) p151<-getPlot(GGP11,4,3) p131<-p131+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p141<-p141+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p151<-p151+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) ``` ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p13 ``` *** Con los outliers que distorsionaban la curva ### `AreaPiso` despues ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p131 ``` *** Han mejorado ### `GarageTotal` antes ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p14 ``` *** Con los outliers que distorsionaban la curva ### `GarageTotal` despues ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p141 ``` *** Tenemos otros outliers que aparecen en `GarageTotal` ### `Habitat` antes ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p15 ``` *** Con los outliers que distorsionaban la curva ### `Habitat` despues ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p151 ``` *** Han mejorado ### Seleccionamos los *outliers* que aparecian en `GarageTotal` y vemos su influencia en `AreaPiso` (puntos en rojo) ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p132<-p131+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$AreaPiso,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none') p152<-p151+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$Habitat,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none') p132 ``` *** No tienen una gran influencia, ni su mantenimiento, ni su eliminacion ### Seleccionamos los *outliers* que aparecian en `GarageTotal` y vemos su influencia en `Habitat` (puntos en rojo) ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p152 ``` *** No tienen una gran influencia, ni su mantenimiento, ni su eliminacion ### Los eliminamos, actualizamos, normalizamos y volvemos a revisar los graficos ````{r} kable(total%>%filter(GarageTotal>0.5 & SalePrice<300000)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"),font_size = 10 ) ``` ```{r echo =TRUE} #Eliminacion registros y normalizado AreaPiso en ambos dataset modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=582) modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1062) modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1191) modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1351) modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso) modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=582) modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1062) modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1191) modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1351) modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso) modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice) ``` *** Volvemos a cargar los graficos y comparamos ### `AreaPiso` antes segundos outliers ```{r collapse=TRUE, echo=FALSE} GGP12<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo") p132<-getPlot(GGP12,4,1) p142<-getPlot(GGP12,4,2) p152<-getPlot(GGP12,4,3) p132<-p132+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p142<-p142+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) p152<-p152+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1)) ``` ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p131 ``` ### `AreaPiso` despues segundos outliers ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p132 ``` ### `GarageTotal` antes segundos outliers ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p141 ``` *** Con los outliers que distorsionaban la curva ### `GarageTotal` despues segundos outliers ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p142 ``` *** Vemos como ha mejorado bastante ### `Habitat` antes segundos outliers ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p151 ``` ### `Habitat` despues segundos outliers ```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'} p152 ``` 1. FILTRADO {data-navmenu="SELECCION Y PREDICCION"} ===========
Vamos a realizar un filtrado de las variables mediante el método `sbf()` del paquete `caret` Vamos a realizarlo con dos funciones internas diferentes para poder comparar y validar los resultados , `ramdom forest` y `modelo lineal` ```{r echo=TRUE} #FILTRADO DE VARIABLES CON CARET #Filtrado con sbf de caret usando RandomForest y Linear Model # Se crea una semilla para cada partición y cada repetición: el vector debe # tener B+1 semillas donde B = particiones * repeticiones. ModeloTrain.Nodummy<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id) set.seed(456) particiones = 10 repeticiones = 5 seeds <- sample.int(1000, particiones * repeticiones + 1) # Control del filtrado Random Forest ctrl_filtrado.rf <- sbfControl(functions = rfSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE) # Control del filtrado Linear Model ctrl_filtrado.lm <- sbfControl(functions = lmSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE) set.seed(234) rf_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.rf,ntree = 500) lm_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.lm) ``` Podemos apreciar que los resultados son iguales De las 25 variables solo se ha descartado 1 `Clase5`. Las que quedan aparecen en las tablas inferiores para los distintos modelos Aplicamos los resultado y eliminamos variable no influyente
```{r collapse=TRUE} #Vemos las variables que tenemos que quedarnos rf_sbf$optVariables%>%kable("html", align = 'clc', caption = 'RANDOM FOREST')%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"), position = "float_left") #optimas variables segun Random Forest lm_sbf$optVariables%>%kable("html", align = 'clc', caption = 'MODELO LINEAL') %>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"), position = "float_right") #optimas variables segun Linear Model ```
```{r} Modelo2.Filtrado<-modelo1.dummy%>%select(-NClase5) Modelo2Train.Filt<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==FALSE) ``` 2. MODELADO {data-navmenu="SELECCION Y PREDICCION"} =========== Antes de empezar a aplicar modelos tenemos que eliminar la variable `Id` de ambos dataset, pero guardando una copia para poder enviar la respuesta ```{r} #Copia seguridad y eliminacion ID CopiaTrain<-Modelo2Train.Filt CopiaTest<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==TRUE) TrainFinal<-CopiaTrain%>%select(-Id) TestFinal<-CopiaTest%>%select(-Id,-SalePrice) ``` Para la fijación de nuestro modelo vamos a elegir el método de la validación cruzada del dataset `Train` con 20 iteraciones No sabiendo que modelo elegir, para lo cual probaremos con el método `train()` del paquete `caret` diversos modelos y veremos que resultados nos aportan Una cosa interesante que aporta este metodo es que llama a los diversos metodos de distintos paquetes con diferentes hiperparametros y se encarga de seleccionar los parametros propios de cada metodo mas eficientes ```{r results='hide',message=FALSE,warning=FALSE,echo=TRUE} #PRUEBAS MODELOS set.seed(234) #MultiVariate Adaptative Regression Splines MARS<-train(TrainFinal[,-25],TrainFinal[,25],'gcvEarth',trControl = trainControl(method = 'cv',number = 20)) #Modelo lineal LM<-train(TrainFinal[,-25],TrainFinal[,25],'lm',trControl = trainControl(method = 'cv',number = 20)) #Ramdom Forest RF<-train(TrainFinal[,-25],TrainFinal[,25],'ranger',trControl = trainControl(method = 'cv',number = 20)) #Modelo lineal rlm<-lm(formula = SalePrice~.,data=TrainFinal) #Regression splines rnd<-lm(formula=SalePrice~bs(Antiguedad)+bs(OverallQual)+bs(BsmtQual)+bs(ExterQual)+bs(FireplaceQu)+bs(GarageFinish)+bs(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal) #Natural splines rnd2<-lm(formula=SalePrice~ns(Antiguedad)+ns(OverallQual)+ns(BsmtQual)+ns(ExterQual)+ns(FireplaceQu)+ns(GarageFinish)+ns(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal) #Generalized Additice Model using SPLINE GAMS<-train(TrainFinal[,-25],TrainFinal[,25],'gamSpline',trControl = trainControl(method = 'cv',number = 20)) #Generalize Linear Models GLM<-train(TrainFinal[,-25],TrainFinal[,25],'glm',trControl = trainControl(method = 'cv',number = 20)) #Bayesian Ridge Regression BRR<-train(TrainFinal[,-25],TrainFinal[,25],'bridge',trControl = trainControl(method = 'cv',number = 20)) #Bayesian Ridge Regression (Model Averaged) BLASSO<-train(TrainFinal[,-25],TrainFinal[,25],'blassoAveraged',trControl = trainControl(method = 'cv',number = 20)) #Extreme gradient boosting XGB<-train(TrainFinal[,-25],TrainFinal[,25],'xgbLinear',trControl = trainControl(method = 'cv',number = 20)) XGBT<-train(TrainFinal[,-25],TrainFinal[,25],'xgbTree',trControl = trainControl(method = 'cv',number = 20)) ``` 3. RESULTADOS {.storyboard data-navmenu="SELECCION Y PREDICCION"} =========== ### Vamos a comparar los modelos elegidos ```{r echo=TRUE} #Comprobacion resultados options(digits=6) model<-list(gcvEarth=MARS,lm=LM,ranger=RF,gamSpline=GAMS,glm=GLM,bridge=BRR,blassoAveraged=BLASSO,xgbLinear=XGB,xgbTree=XGBT) result.resamples<-resamples(model) #Resutados metricas_resamples <- result.resamples$values%>%gather(key = "modelo", value = "valor", -Resample)%>%separate(col = "modelo", into = c("modelo", "metrica"), sep = "~", remove = TRUE) ``` ```{r} #Tabla resultados kable(metricas_resamples %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared)))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover")) ``` *** * `MAE`: Mean Absolute Error. Media de errores absolutos * `RMSE`: Root Mean Squared Error. Raiz cuadradra de la media de los residuos al cuadrado. * `RSquared`: Bondad del ajuste. Es la relacion entre la suma de los cuadrados de regresion y la suma total de cuadrados. Aunque el uso de un tipo de indicador u otro favorece ciertas caracteristicas en cada modelo, parece claro que hay dos que estan por encima de los demas en todos los indicadores ### Resultados de los modelos con los distintos criterios. (La escala X esta recortada para mejor visualizacion) . ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15} graf2<-bwplot(result.resamples,scales=list(relation="free"),xlim=list(c(13000,30000),c(18000,50000),c(0.7,1))) graf2 ``` ### Modelos ordenados por `Rsquared`. ```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=10} #Grafico graf1<-metricas_resamples %>% filter(metrica == "Rsquared") %>% group_by(modelo) %>% summarise(media = mean(valor)) %>% ggplot(aes(x = reorder(modelo, media), y = media, label = sprintf("%0.4f",round(media, 4)))) graf1<-graf1+ geom_segment(aes(x = reorder(modelo, media), y = 0, xend = modelo, yend = media), color = "grey50") graf1<-graf1+ geom_point(size = 14, color = "firebrick") + geom_text(color = "white", size = 3.5) + scale_y_continuous(limits = c(0.75, 1)) graf1<-graf1 + labs(title = "Rsquare con CV", subtitle = "Modelos ordenados por media", x = "modelo") graf1<-graf1+ coord_flip() + theme_bw() graf1 ``` *** Los modelos que parecen mas efectivos son `RandomForest`, y `xgbTree` * `ranger`: RandomForest es un ensamble en paralelo (bagging) de arboles de predicción en los que se selecciona aleatoriamente los predictores en cada nodo * `xgbTree`: eXtreme Gradient Boosting es un ensamble secuencial (boosting) de arboles de predicción en el que cada árbol intenta minimizar los residuos del anterior Los otros modelos que también dan buenos resultados son: * `GAMSpline` :Generalized Additive Model using Splines es una combinacion lineal de funciones no lineales.Se trata de combinar distintos tipos de regresión en un conjunto no lineal, usando aquí smooth Splines * `gvcEarth`: MultiVariate Adaptative Regression Splines es parecido al anterior pero usando regression splines * `XGBLinear` es un un ensamble secuencial como XGBoost pero orientado hacia el modelo lineal 4. PREDICCION {data-navmenu="SELECCION Y PREDICCION"} =========== En un data frame elijo en varias columnas las predicciones que me da cada modelo ```{r echo =TRUE} #Calculos previos para ponderaciones RS<-metricas_resamples%>%filter(metrica=="Rsquared") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared)) RSM<-metricas_resamples%>%filter(metrica=="MAE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(MAE)) RSE<-metricas_resamples%>%filter(metrica=="RMSE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(RMSE)) RST<-RS%>%spread(modelo,Rsquared) RSMT<-RSM%>%spread(modelo,MAE) RSET<-RSE%>%spread(modelo,RMSE) #Calculo para distintas ponderaciones SumaRs<-RST$ranger+RST$gamSpline+RST$xgbTree+RST$gcvEarth+RST$xgbLinear SumaRSM<-((1/RSMT$ranger)+(1/RSMT$gamSpline)+(1/RSMT$xgbTree)+(1/RSMT$gcvEarth)+(1/RSMT$xgbLinear)) SumaRSE<-((1/RSET$ranger)+(1/RSET$gamSpline)+(1/RSET$xgbTree)+(1/RSET$gcvEarth)+(1/RSET$xgbLinear)) ```
```{r echo=TRUE} #Prediccion result<-CopiaTest%>%select(-SalePrice) result$RF<-predict(RF,TestFinal) result$GAM<-predict(GAMS,TestFinal) result$XGBT<-predict(XGBT,TestFinal) result$MARS <-predict(MARS,TestFinal) result$XGB <-predict(XGB,TestFinal) result$media<-round(((result$RF+result$GAM+result$XGBT+result$MARS+result$XGB)/5),digits = 1) #ponderada sobre Rsquared result$ponderada<-round((((result$RF*RST$ranger)+(result$GAM*RST$gamSpline)+(result$XGBT*RST$xgbTree)+(result$MARS*RST$gcvEarth)+(result$XGB*RST$xgbLinear))/SumaRs),digits = 1) #Ponderada sobre MAE result$ponderada1<-round((((result$RF/RSMT$ranger)+(result$GAM/RSMT$gamSpline)+(result$XGBT/RSMT$xgbTree)+(result$MARS/RSMT$gcvEarth)+(result$XGB/RSMT$xgbLinear))/SumaRSM),digits = 1) #Ponderada sobre RMSE result$ponderada2<-round((((result$RF/RSET$ranger)+(result$GAM/RSET$gamSpline)+(result$XGBT/RSET$xgbTree)+(result$MARS/RSET$gcvEarth)+(result$XGB/RSET$xgbLinear))/SumaRSE),digits = 1) #Redondeo hacia arriba en centenas de los valores result$RF<-100*ceiling((result$RF/100)) result$GAM<-100*ceiling((result$GAM/100)) result$XGBT<-100*ceiling((result$XGBT/100)) result$MARS<-100*ceiling((result$MARS/100)) result$XGB<-100*ceiling((result$XGB/100)) result$media<-100*ceiling((result$media/100)) result$ponderada<-100*ceiling((result$ponderada/100)) result$ponderada1<-100*ceiling((result$ponderada1/100)) result$ponderada2<-100*ceiling((result$ponderada2/100)) ``` ```{r echo=TRUE,eval=FALSE} Fin<-result%>%select(Id,SalePrice=media) Fin1<-result%>%select(Id,SalePrice=RF) Fin2<-result%>%select(Id,SalePrice=GAM) Fin3<-result%>%select(Id,SalePrice=XGBT) Fin4<-result%>%select(Id,SalePrice=MARS) Fin5<-result%>%select(Id,SalePrice=XGB) Fin6<-result%>%select(Id,SalePrice=ponderada) Fin7<-result%>%select(Id,SalePrice=ponderada1) Fin8<-result%>%select(Id,SalePrice=ponderada2) write.csv(Fin,file="Ames2_house.csv",row.names = FALSE) write.csv(Fin1,file="Ames2_house1.csv",row.names = FALSE) write.csv(Fin2,file="Ames2_house2.csv",row.names = FALSE) write.csv(Fin3,file="Ames2_house3.csv",row.names = FALSE) write.csv(Fin4,file="Ames2_house4.csv",row.names = FALSE) write.csv(Fin5,file="Ames2_house5.csv",row.names = FALSE) write.csv(Fin6,file="Ames2_house6.csv",row.names = FALSE) write.csv(Fin7,file="Ames2_house7.csv",row.names = FALSE) write.csv(Fin8,file="Ames2_house8.csv",row.names = FALSE) ``` 5. TEST {data-navmenu="SELECCION Y PREDICCION"} ===========
Estos son los resultado en `KAGGLE` El valor corresponde al resultado aplicado al `TEST` que nos da `RMSLE`: *Root Mean Squared Logarithmic Error*   similar al `RMSE` pero aplicando una reduccion logaritmica previa a los datos

Column {data-width=700} ----------- Podemos apreciar que los valores son muy parecidos tanto en la media directa de los modelos escogidos como en aquella ponderacion con el criterio que sea
### **Medias y Ponderadas** ```{r fig.height=3} include_graphics('Kaggle1.bmp') ``` Column {data-width=700} ----------- Aunque se mantiene el orden de eficiencia que habiamos obtenido de los modelos durante el entrenamiento , hay que destacar que cualquier mezcla de varios sea con el criterio que sea de ponderacion es mejor que el mejor de los modelos en solitario ### **Modelos** ```{r fig.height=3} include_graphics('Kaggle2.bmp') ```